home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / textyl / psrc / textyl.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-07  |  214KB  |  7,874 lines
  1.  
  2. (*$b0*)
  3.  
  4. program tyldvidvi(input,output);
  5. (* ----------------------------------------------------------
  6.         TeXtyl  line-drawing interface for TeX.
  7.           copyright (c) 1987 John S. Renner 
  8.               All rights reserved.
  9.         
  10. ABSTRACT: TeXtyl reads in a DVI file, and processes 'specials'
  11.         that refer to graphics capabilities that it knows about,
  12.         like line, spline, ThickThinSpline, and musical 
  13.         beams and slurs. TeXtyl then outputs a new DVI file, 
  14.         with the special-macros expanded and converted to 
  15.         DVI-commands for character setting.
  16.         
  17. DEPENDENCIES:  Few assumptions about Pascal are assumed. All
  18.         identifiers are unique to eight characters. There are
  19.         notes to indicate system-dependencies.
  20.         I assume the standard definition of "READ(fil, x)" to be
  21.         equivalent to "x := fil^; GET(fil)" , and
  22.         "WRITE(fil, x)" == "fil^ := x; PUT(fil)" .
  23.     Arrays are passed by reference (VAR) for efficiency.
  24.         See also the "sysdependent"  procedure; 
  25.         Problem areas, or areas for expansion are marked with ###
  26.  
  27. -------------------------------------------------------------*) 
  28. (* Revision History:
  29.     Jun. 1986  v1.0   Basic version of TeXtyl
  30.     Dec. 1986  v1.1   Added adaptive subdivision for spline
  31.                 interpolation. Added Cardinal basis.
  32.     Mar. 1987  v1.2   Added F and W flags for beginfigure
  33.             to allow required and/or actual dimensions
  34.                 to interface with files output by the
  35.             DP drawing program from Carnegie-Mellon
  36.             also various fixes
  37.     Apr. 1987  v1.3   Added linestyles (dotted, dashed, dotdashed)
  38.             
  39. *)
  40.  
  41. label
  42.     666, 30; 
  43. (*=====================CONST============================*)
  44. #include "tylext.h"
  45. #include "texpaths.h"
  46.  
  47. const
  48.   TylVersion = 'This is TeXtyl, Version 1.30';
  49.             (* for dvi-commands *)
  50.   PUT1         = 133;
  51.   SET1         = 128;
  52.   PUTRULE     = 137;
  53.   NOP         = 138;
  54.   PUSH         = 141;
  55.   POP         = 142;
  56.   RIGHTLEFT     = 143;
  57.   DOWNUP     = 157;
  58.   FONTDEF     = 244;
  59.   USEFONT     = 236; 
  60.   OURFONTFLAG     = 256; (* our special 'byte' value flag *)
  61.  
  62.   USESTDAREA = 0;    (* flag to use the 'standard' area to find .tfm files *)
  63.  
  64.         (* some conversions and numbers *)
  65.   SPPERPT     = 65536;   (* scaled points per printers point *)
  66.   SPPERMM     = 186468;  (* scaled pts per millimetre *)
  67.  
  68.   RADTODEG     = 57.29577952;     (* degrees per radian *)
  69.   DEGTORAD     = 0.0174532925; (* radians per degree *)
  70.   PI         = 3.141592654;
  71.  
  72.   TWO16 =      65536;     (* 2 ^ 16 *)
  73.   TWO20 =    1048576;    (* 2 ^ 20 *)
  74.   TWO23 =    8388608;
  75.   TWO24 =   16777216;
  76.   TWO27 =  134217728;
  77.   TWO31 = 2147483647; (* 2^31 - 1 *)
  78.  
  79.   BIGREAL = 1.0e30;
  80.   MAXVECLENsp    = 262144; (*  Normal maximum length of longest
  81.                  *  vector-font character in scaled points
  82.                *)
  83.  (* Music Font dependent constants *)
  84.   DOTCHAR       = 127;   (* ascii number of char that is a dot *)
  85.   QNOTEGHUS     = 18.0;  (* MF: Global Horizontal Units for a Quarternote *)
  86.   QNOTEGVUS     = 16.0;  (* MF: Global Vertical units for a quarternote *)
  87.   GBMGHUS       = 12.0;  (* MF: horizontal units for a grace beam *)
  88.   GBMGVUS       = 9.0;
  89.  
  90.   BMSTART     = 0;  BMEND = 69;  (* indices for start/end of the beam chars *)
  91.   LOBM1       = 0;         (* indices for the regular beam chars that *)
  92.   HIBM1       = 34;         (*   are 1 quarternote long, and *)
  93.   LOBM1p5     = 35;         (*   for those that are 1.5 quarternotes long *)
  94.   HIBM1p5     = 69;
  95.   
  96.   GBMSTART     = 70; GBMEND = 105;  (* indices for the grace beams *)
  97.   LOGBMp5      = 70;            (* indices for grace beam chars that *)
  98.   HIGBMp5      = 87;        (* are 0.5 grace quarternote long, and *)
  99.   LOGBMp66     = 88;        (* 0.66 grace quarternotes long *)
  100.   HIGBMp66     = 105;
  101.  
  102.   LoVThick     = 1;        (* Bounds for Vector char thicknesses *)
  103.   HiVThick     = 13;
  104.  
  105.   SizVFontTable    = 39; (* size of the Vector Font Table *) { 3*HiVThick }
  106.   SizMFontTable    = 18;(* size of the Music Font Table *)
  107.   MAXLABELFONTS    = 5;
  108.   SizLFontTable = MAXLABELFONTS;  (* size of the Label Font Table *)
  109.  
  110.   MAXCTLPTS     = 63; (* max number of control points *)
  111.   MAXCTLPTSp3    = 66; (* max control points + 3 *)
  112.   ARRLIMIT      = 100;    (* limit for strings and other arrays *)
  113.   MAXSPLINESEGS = 480;  (* max number of spline segments *)
  114.   MAXOLEN      = 128;    (* max length of Ostring that holds bytes of dvi cmds *)
  115.   MAXTBDs       = 50;    (* max number of Fonts-to-be-Defined *)
  116.  
  117.   MAXDVISTRINGS    = 600;    (* max number of DVI Ostrings per page *)
  118.   TFMSIZE     = 8000;    (* size of TFM array to hold .tfm file info *)
  119.   
  120.           (* Numeric names for the TeXtyl primitives *)
  121.   Aline         = 1; (* should be first *)
  122.   Aspline     = 2;
  123.   Attspline     = 3;
  124.   Abeam         = 4;
  125.   Atieslur     = 5;
  126.   Aarc         = 6;
  127.   Alabel     = 7;
  128.   Afigure     = 8; (* should be last one *)
  129.  
  130.   MAXFONTS     = 60;     (* number of TeX fonts to keep track of *)
  131.   STACKSIZE     = 50;     (* size of stack for pushes and pops *)
  132.   AREALENGTH     = TYLPATHLEN;  (* see also "sysdependent" proc for this value*)
  133.  
  134.   CR     = 13;    (* numbers of certain ascii characters  *)
  135.   LF     = 10;
  136.   HT     = 9;
  137.   FF     = 12;
  138.   ERRSIGNAL     = '?';
  139.   ERRNOTBAD    = 0;
  140.   ERRBAD     = 1;
  141.   ERRREALBAD    = 2;
  142.     
  143.  
  144.   READACCESS    = 4;
  145.   WRITEACCESS    = 2;
  146.   NOPATH    = 0;
  147.   FONTPATH    = 3;
  148.  
  149.  
  150.  
  151. (*===========================TYPES=============================*)
  152. type
  153.         (* ---- Bytes ---- *)
  154.  
  155.    Inbyt     = -128 .. 127;
  156.  
  157.    OctByt     = 0 .. 256;   (* DVI commands are 0..255, but we need
  158.                               one more for an internal flag *)
  159.    bytefile = packed file of Inbyt;
  160.  
  161.         (* ---- Strings ---- *)
  162.    asciicode     = 32 .. 126; 
  163.    charstring     = packed array [1 .. ARRLIMIT] of char;
  164.    ascstring     = packed array [1 .. ARRLIMIT] of asciicode;
  165.         (* rep for character strings *)
  166.    strng     = record 
  167.                 len: 0 .. ARRLIMIT;
  168.                 str:charstring;
  169.             end;
  170.         (* rep for ascii strings *)
  171.    astrng     = record 
  172.                 len: 0 .. ARRLIMIT;
  173.                 str: ascstring;
  174.             end; 
  175.         (* byte strings *)
  176.    pOstring     = ^Ostring;
  177.    Ostring      = packed array[1 .. MAXOLEN] of OctByt;
  178.  
  179.         (* ---- PUBLIC types ---- *)
  180.    VThickness     = LoVThick .. HiVThick;
  181.    VectKind       = (VKCirc, VKVert, VKHort);
  182.    BeamKind       = (regular, grace);
  183.    SplineKind     = (BSPL, INTBSPL, CATROM, CARD);
  184.    LineStyle    = (solid, dotted, dashed, dotdash);
  185.    ScaledPts      = integer;
  186.    MusIndex       = integer;
  187.    VecIndex       = integer;
  188.  
  189.    ThickAryType        = array[0 .. MAXSPLINESEGS] of VThickness;
  190.    SplineSegments     = array[1  ..  MAXSPLINESEGS, 1 .. 2] of ScaledPts;
  191.    ControlPoints      = array [0 .. MAXCTLPTSp3, 1 .. 2] of ScaledPts;
  192.  
  193.  
  194.         (* ----- Private Types ---- *)
  195.    FontInfRec = record
  196.                   Cht, Cdp, Cwd : ScaledPts;
  197.                   Angle : real;
  198.                   end;
  199.  
  200.    pVectFontInfRec    = ^VectFontInfRec;   (* vector font info *)
  201.    VectFontInfRec    = record
  202.               vkind : VectKind;
  203.               DesSize : ScaledPts;
  204.               PenSize : ScaledPts;
  205.               psize : VThickness;
  206.               MaxVectLen : ScaledPts;
  207.               FontName : strng;
  208.               Cksum : integer;
  209.               Isdefined : boolean;
  210.               DVIFontNum: integer;
  211.               FontInfo : array [0 .. 127] of FontInfRec;
  212.               end;
  213.  
  214.    pMusFontInfRec     = ^MusFontInfRec;    (* music font info *)
  215.    MusFontInfRec      = record
  216.               DesSize : ScaledPts;
  217.               Family : integer;
  218.               FontName : strng;
  219.               Cksum : integer;
  220.               Isdefined : boolean;
  221.               DVIFontNum: integer;
  222.               Staffsize : integer;
  223.               ghu : ScaledPts;
  224.               gvu : ScaledPts;
  225.               FontInfo : array [0 .. 127] of FontInfRec;
  226.               end;
  227.  
  228.    pLabFontInfRec    = ^LabFontInfRec;  (* label fonts info *)
  229.    LabFontInfRec    = record
  230.                  DesSize : ScaledPts;
  231.                  FontName : strng;
  232.               Cksum : integer;
  233.               Isdefined : boolean;
  234.               DVIFontNum : integer;
  235.               internalnumber : integer;
  236.               spacewidth : ScaledPts;
  237.               end;
  238.  
  239.  
  240.         (* list of dvi-strings *)
  241.    dvistary     = array[1 .. MAXDVISTRINGS] of pOstring;
  242.  
  243.    DVIBuftype     = record
  244.           TotByteLen : integer;
  245.           Numstrings : integer;
  246.           curstrindex : integer;
  247.           Dstrings : dvistary;
  248.           end;
  249.  
  250.         (* representation of list of fonts that have to be defined
  251.          *    before we output the BOP of the page we
  252.          *    just scanned 
  253.          *)
  254.    ToBeDefinedRec = record
  255.                     which : char; 
  256.                     indx : integer;
  257.                     end;
  258.  
  259.    stackrec = record 
  260.           sh, sv, sw, sx, sy, sz: integer;
  261.           end;
  262.  
  263.    Stacktype     = array [0 .. STACKSIZE] of stackrec;
  264.  
  265.    Oneby4Vector        = array[1 .. 4] of real;
  266.    Fourby4Matrix    = array[1 .. 4, 1 .. 4] of real;
  267.    Oneby5Vector        = array[1 .. 5] of real;
  268.    
  269.    Primitive = Aline .. Afigure;
  270.  
  271.    pItem    = ^Item;
  272.    figptr    = ^Figure;
  273.  
  274.    Item = packed record
  275.        nextitem : pItem;
  276.        BBlx, BBby, BBrx, BBty : ScaledPts; (* Bounding box *)
  277.        itemthick : VThickness;
  278.        itemvec : VectKind;
  279.        itempatt : LineStyle;
  280.        case kind : Primitive of
  281.            Aline : (    lx1, ly1, lx2, ly2 : ScaledPts;
  282.             );
  283.            Aspline : (    spltype : SplineKind;
  284.                 sclosed : boolean;
  285.                 dosmarks : integer;
  286.                 nsplknots : integer;
  287.                 spts : ControlPoints;
  288.               );
  289.            Attspline : (    tspltype : SplineKind;
  290.                 tclosed : boolean;
  291.                 dottmarks : integer;
  292.                 nttknots : integer;
  293.                 ttpts : ControlPoints;
  294.                 ttarry : ThickAryType;
  295.                 );
  296.            Abeam : (    bx1, by1, bx2, by2 : ScaledPts;
  297.                 staf : integer;
  298.                 bkind : BeamKind;
  299.             );
  300.            Atieslur : (    ntknots : integer;
  301.                 minth, maxth : VThickness;
  302.                 tspts : ControlPoints;
  303.                );
  304.            Aarc : (        acentx, acenty : ScaledPts;
  305.                 aradius : ScaledPts;
  306.                 firstang, lastang : integer;
  307.                 narcknots : integer;
  308.                 arcpts : ControlPoints;
  309.                );
  310.            Alabel : (    labx, laby : ScaledPts;
  311.                        fontstyle : integer;
  312.                 labeltext : strng;
  313.             );
  314.            Afigure : (    figtheta : real;
  315.                 fsx, fsy : real;
  316.                 fdx, fdy : ScaledPts;
  317.                 preWid, preHt : ScaledPts;
  318.                 postWid, postHt : ScaledPts;
  319.                 depthnumber : integer;
  320.                 body : figptr;
  321.               );
  322.           end;
  323.  
  324.    
  325.    Figure = record
  326.         things : pItem;
  327.         end;
  328.  
  329.  
  330. (*==============================VARS============================*)
  331. var
  332.    (* ----- Private vars *)
  333.     catrommtx : Fourby4Matrix;    (* basis matrix for catmul-rom splines*)
  334.     bsplmtx : Fourby4Matrix;    (* basis matrix for B-splines *)
  335.     cardmtx : Fourby4Matrix;    (* Cardinal spline matrix *)
  336.     lastPoint : integer;    (* num of output points *)
  337.     intervals : integer;    (* count of spline interval we are on *)
  338.     ourxpos,            (* internal x-position on page *)
  339.     ourypos,             (* internal y-position on page *)
  340.     ourfontnum : integer;    (* internal number of TeX font currently in use*)
  341.     ourpushdepth : integer;    (* depth of internal pushes *)
  342.     origTexfont : integer;    (* number of TeX font in use before tyling *)
  343.  
  344.     GDVIBuf : DVIBuftype;    (* Global DVI buffer that contains a list of
  345.                      * dvi commands for this page. All dvi-cmds
  346.                  * parsed are put here and possibly modified
  347.                  * before being written  to the output file
  348.                  *)
  349.  
  350.     VFontTable : array [1 .. SizVFontTable] of pVectFontInfRec;
  351.     MFontTable : array [1 .. SizMFontTable] of pMusFontInfRec;
  352.     LFontTable : array [1 .. SizLFontTable] of pLabFontInfRec;
  353.     (* the font tables, and the number of fonts defined in each *)
  354.     VFontsDefd, 
  355.     MFontsDefd,
  356.     LFontsDefd : integer;
  357.  
  358.     GDVIFN : integer;           (* dvi font number currently in use *)
  359.  
  360.             (* table of fonts yet  To-Be-Defined *)
  361.     TBD : array[1 .. MAXTBDs] of  ToBeDefinedRec;
  362.     FTBDs : integer;              (* number of fonts to be defined for current page *)
  363.  
  364.     pageitems : pItem;  (* list of primitives in current use in the current
  365.                  * figure on the current page
  366.              *)
  367.  
  368.     TotBytesWritten : integer; 
  369.     ourq : integer; (* the 'q' for the postpost *)
  370.     specstart: integer;        (* the place in the DVI buffer where the
  371.                      * start of the special begins.
  372.                  * this is so that we know how far to back up
  373.                  * and over-write the old \special macro string
  374.                  * with the cmds of our 'macro-expansion'
  375.                  *)
  376.  
  377.     multifigure : integer;    (* depth of definition recursion of figures *)
  378.     didnewfonts : boolean;    (* did we define the new fonts for this page? *)
  379.     prevfont : integer;        (* to keep track of prev font before the
  380.                      * PUSH and expansion of the special
  381.                  *)
  382.  
  383.     pgfigurenum : integer;    (* figure number for this page *)
  384.     currpagenum : integer;    (* number of page we are on *)
  385.     skiptsclamp : boolean;    (* DEBUG: should we skip post-clamping ties *)
  386.     dviBBlx, dviBBrx,         (* Bounding box of figure in DVI space *)
  387.     dviBBby, dviBBty : ScaledPts;
  388.     ErrorOccurred : boolean;    (* global flag in case some error happened *)
  389.  
  390.  
  391.     thefilename, realnameoffile : charstring; (* used externally *)
  392.  
  393.   (* ----- End private vars *)
  394.  
  395.  
  396.     tfmbyte : Inbyt;
  397.  
  398.     vaxbyt : Inbyt;
  399.  
  400.     tfm: array[-100 .. TFMSIZE] of OctByt;
  401.  
  402.     xord: array [char] of asciicode;
  403.     xchr: array [0 .. 255] of char;
  404.     outname: strng;    (* name of output file *)
  405.     tfmname : strng;    (* name of a .tfm file *)
  406.     dvifname : strng;    (* name of the input dvi file *)
  407.     logfilnam: strng;    (* name of the log file *)
  408.  
  409.     dvifile: bytefile;    
  410.     tfmfile: bytefile;
  411.     outputfil: bytefile;
  412.     logfile : text;
  413.  
  414.     curfont: integer;
  415.     s : 0 .. STACKSIZE;
  416.     h, v, w, x, y, z: integer;
  417.     stack: Stacktype;
  418.  
  419.     font: array [0 .. MAXFONTS] of 
  420.         record 
  421.             num: integer;
  422.             name: astrng;
  423.             checksum: integer;
  424.             scaledsize: integer;
  425.             designsize: integer;
  426.             space: integer;
  427.             bc: integer;
  428.             ec: integer;
  429.             widths: array [0 .. 127] of ScaledPts
  430.         end;
  431.     nf : 0 .. MAXFONTS; 
  432.  
  433.     MINREAL : real;     (* a system-dependent 'constant' *)
  434.     b0, b1, b2, b3: OctByt; 
  435.     inwidth: array [0 .. 255] of integer;
  436.     tfmchecksum: integer; 
  437.     conv: real;
  438.     trueconv: real; 
  439.     numerator, 
  440.     denominator: integer;
  441.     defaultdirectory: strng;
  442.     mag, 
  443.     magfactor: real; 
  444.     maxv, maxh, maxs : integer;
  445.     maxpages, 
  446.     totalpages : integer;
  447.     resolution: real;
  448.     inpostamble : boolean;
  449.     newbackptr, 
  450.     oldbackptr : integer;    
  451.     p, k : integer;
  452.     waste : integer;
  453.         
  454.  
  455. (* ==================forward declarations============================ *)
  456.  
  457. {  These hooks assume that the parameters are filled "correctly",
  458.     and are already transformed into 4th Quadrant DVI-space    }
  459.  
  460.  
  461. procedure TylTieSlur (var KnotArray: ControlPoints; 
  462.                       numknots: integer;
  463.                       minthick, maxthick: VThickness); forward;
  464.  
  465. procedure TylThickThinSpline (thetype : SplineKind; 
  466.               isclosed : boolean;
  467.                           var KnotArray: ControlPoints; 
  468.                           var ThikThinAry: ThickAryType;
  469.                           numknots: integer;
  470.                           vec: VectKind;
  471.               patt: LineStyle;
  472.               domarks : integer); forward;
  473.  
  474. procedure TylSpline (thetype : SplineKind; 
  475.               isclosed : boolean;
  476.                       var KnotArray: ControlPoints; 
  477.               numknots: integer;
  478.                       thick: VThickness; 
  479.               vec: VectKind;
  480.               patt: LineStyle;
  481.               domarks : integer); forward;
  482.  
  483. procedure TylLine (xl, yb, xr, yt: ScaledPts; 
  484.                      thickness: VThickness; 
  485.              vec: VectKind;
  486.              patt: LineStyle); forward;
  487.  
  488. procedure TylBeam (fromx, fromy, tox, toy: ScaledPts;
  489.                  staffsize : integer; 
  490.              kind : BeamKind); forward;
  491.  
  492. procedure TylArc (radius : ScaledPts; 
  493.           centx, centy : ScaledPts;
  494.           firstangle, secondangle : integer;
  495.           thick : VThickness; 
  496.           vec : VectKind;
  497.           patt: LineStyle); forward;
  498.  
  499. procedure TylLabel (xpos, ypos : ScaledPts;
  500.             fontstyle : integer;
  501.             phrase : charstring;
  502.             phraselen : integer); forward;
  503.  
  504. (*  private procedures *)
  505. procedure definebeams (var M : pMusFontInfRec); forward;
  506. procedure definevectors (var Vec: pVectFontInfRec); forward;
  507. procedure defineNewfonts; forward;
  508. procedure doTylArc (iscircle : boolean; var apts : ControlPoints;
  509.             numknots : integer; thick : VThickness; 
  510.             vec : VectKind; patt : LineStyle); forward;
  511. procedure strcopy (src : charstring; var dest : charstring; 
  512.             len : integer); forward;
  513. procedure writestrng (s :strng; tologfile : boolean); forward;
  514. (* end private procs *)
  515.  
  516. {------------------------------------------------------}
  517. procedure jumpout;
  518. begin
  519.     goto 666; (* global label *)
  520. end; 
  521.  
  522.  
  523. (*-------------- System Dependent stuff ----------------------*)
  524. (*  the default-directory should be where the .tfm files are 
  525.  *  to be found. the string len should reflect this name.
  526.  *  Check with the local site maintainer about any necessary
  527.  *  additions to the reset and rewrite procedures for opening
  528.  *  8-bit binary files.
  529.  *)
  530.  
  531.  
  532.  
  533.  
  534.  
  535. procedure sysdependent;
  536.  begin
  537.  
  538.  
  539.     setpaths;
  540.  
  541.     defaultdirectory.str := TYLPATH;
  542.     defaultdirectory.len := TYLPATHLEN; (* AREALENGTH const should be this, too *)
  543.     writeln(TylVersion,' for Berkeley Unix');
  544.  
  545.     resolution := 300.0; (* just a number *)
  546.     MINREAL := 1.0e-20;  (* so that we avoid some underflows *)
  547.  end;
  548.  
  549. {------------------------------------------------------------}
  550. procedure complain (severity :integer);
  551. begin
  552.  writeln(logfile,'Error in fig#',pgfigurenum:0,' on page ',currpagenum:0);
  553.  case severity of
  554.    ERRNOTBAD : begin
  555.            write (ERRSIGNAL);
  556.            end;
  557.    ERRBAD : begin
  558.            write (ERRSIGNAL);
  559.                 ErrorOccurred := true;
  560.            end;
  561.    ERRREALBAD : begin
  562.              write (ERRSIGNAL,'! ');
  563.                 ErrorOccurred := true;
  564.            end;
  565.               
  566.   end; (* case *)
  567. end;
  568.  
  569. function opendvifile : boolean;
  570. begin
  571.  
  572.     strcopy (dvifname.str, thefilename, dvifname.len);
  573.     thefilename[dvifname.len + 1] := ' ';
  574.     if (testaccess (READACCESS, NOPATH)) then
  575.       begin
  576.       reset (dvifile, realnameoffile);
  577.       opendvifile := true;
  578.       end
  579.     else
  580.       begin
  581.       writestrng(dvifname, false);
  582.       writeln(' : DVI file not found/readable ');
  583.       opendvifile := false;
  584.       end;  
  585.  
  586. end;
  587.  
  588. function opentfmfile : boolean;
  589. begin
  590.  
  591.   strcopy (tfmname.str, thefilename, tfmname.len);
  592.   thefilename[tfmname.len + 1] := ' ';
  593.   if (testaccess (READACCESS, FONTPATH)) then
  594.     begin
  595.     reset(tfmfile, realnameoffile);
  596.     opentfmfile := true;
  597.     end
  598.   else
  599.     begin
  600.     writestrng(tfmname, false);
  601.     writeln(' : TFM file not fount/readable ');
  602.     opentfmfile := false;
  603.     end;
  604.  
  605. end;
  606.  
  607. procedure openoutputfile;
  608. begin
  609.  
  610.   strcopy (outname.str, thefilename, outname.len);
  611.   thefilename[outname.len + 1] := ' ';
  612.   if (testaccess (WRITEACCESS, NOPATH)) then
  613.     rewrite (outputfil, realnameoffile)
  614.   else
  615.     begin
  616.     writestrng(outname, false);
  617.     writeln(' : Output file not writable');
  618.     jumpout;
  619.     end;
  620.  
  621. end;  
  622.  
  623. procedure openlogfile;
  624. begin
  625.  
  626.   strcopy (logfilnam.str, thefilename, logfilnam.len);
  627.   thefilename[logfilnam.len + 1] := ' ';
  628.   if (testaccess (WRITEACCESS, NOPATH)) then
  629.     rewrite (logfile, realnameoffile)
  630.   else
  631.     begin
  632.     writestrng(logfilnam, false);
  633.     writeln(' : Log file not writable');
  634.     jumpout;
  635.     end;
  636.  
  637. end;
  638.  
  639.  
  640. (* &&Module Tylsupport *)
  641.  
  642.  
  643. {---------------------------------------------------}
  644. procedure ClearBufString (var s : pOstring);
  645. (* clear a DVI buffer string  to contain no-ops*)
  646. var i : integer;
  647. begin
  648.   for i := 1 to MAXOLEN do
  649.     s^[i] := NOP;
  650. end;
  651.  
  652. {---------------------------------------------------}
  653. function NewBufString : pOstring;
  654. var s : pOstring;
  655. begin
  656.  new (s);
  657.  ClearBufString (s);
  658.  NewBufString := s;
  659. end;
  660.  
  661.  
  662.  
  663. (* NOTATION::
  664.  *       All procedures that put a dvi-command into the
  665.  *  temporary buffer are prefixed with "cmd"...
  666.  *       Functions that deal with reading .tfm files are prefixed
  667.  *  with "T" or have "tfm" in their names.       
  668.  *       Functions that deal with reading DVI files are
  669.  *  prefixed with a "D". 
  670.  *)
  671.  
  672. {--------------------------------------------}
  673. procedure cmd1byte (cmd : OctByt);
  674. begin
  675.   with GDVIBuf do
  676.     begin
  677.     if (Numstrings > MAXDVISTRINGS) then (* buffer full *)
  678.       begin
  679.       complain (ERRREALBAD);
  680.       writeln (logfile,'error: too many dvistrings. Totbytes = ',TotByteLen);
  681.       jumpout;
  682.       end;
  683.     if (curstrindex > MAXOLEN) then  (* current string full *)
  684.       begin
  685.       Numstrings := Numstrings + 1;
  686.       if (Dstrings[Numstrings] <> nil) then
  687.          dispose (Dstrings[Numstrings]);
  688.       Dstrings[Numstrings] := NewBufString;
  689.       ClearBufString(Dstrings[Numstrings]);
  690.       curstrindex := 1;
  691.       end;
  692.     Dstrings[Numstrings]^[curstrindex] := cmd; (* insert command byte *)
  693.     TotByteLen := TotByteLen + 1;
  694.     curstrindex := curstrindex + 1;
  695.     end;
  696. end;
  697.       
  698.  
  699. {---------------------------------------------------}
  700. procedure cmd2byte (cmd : integer);
  701. begin
  702.   cmd1byte (cmd div 256);
  703.   cmd1byte (cmd mod 256);
  704. end;
  705.  
  706. {---------------------------------------------------}
  707. procedure cmd3byte (cmd : integer);
  708. begin
  709.   cmd1byte (cmd div TWO16);
  710.   cmd1byte ((cmd div 256) mod 256);
  711.   cmd1byte (cmd mod 256);
  712. end;  
  713.  
  714. {---------------------------------------------------}
  715. procedure cmd4byte (cmd : integer);
  716. var tmp : integer;
  717. begin
  718.   tmp := cmd;
  719.   if (tmp >= 0) then
  720.     begin
  721.     cmd1byte (tmp div TWO24);
  722.     end
  723.   else
  724.     begin
  725.     tmp := tmp + TWO31 + 1; (* need the +1 *)
  726.     cmd1byte (tmp div TWO24 + 128);
  727.     end; 
  728.   tmp := tmp mod TWO24;
  729.   cmd1byte (tmp div TWO16);
  730.   tmp := tmp mod TWO16;
  731.   cmd1byte (tmp div 256);
  732.   cmd1byte (tmp mod 256);
  733. end;
  734.  
  735. {---------------------------------------------------}
  736. (* ### may be system dependent as integers are assumed 
  737.    to be signed 32-bits *)
  738.  
  739. procedure cmdSigned (i : integer; numbytes: integer);
  740. var tmp : integer;
  741. begin
  742.   if (numbytes = 4) then
  743.     cmd4byte (i)
  744.   else
  745.     begin     (* <= 3 bytes *)
  746.     tmp := i;
  747.     if (numbytes = 3) then
  748.       begin
  749.       if (tmp < 0) then
  750.         tmp := tmp + TWO24;
  751.       cmd1byte (tmp div TWO16);
  752.       tmp := tmp mod TWO16;
  753.       cmd1byte (tmp div 256);
  754.       end;
  755.     if (numbytes = 2) then
  756.       begin
  757.       if (tmp < 0) then
  758.     tmp := tmp + TWO16;
  759.       cmd1byte (tmp div 256);
  760.       end;  
  761.     if (numbytes = 1) then
  762.       begin
  763.       if (tmp < 0) then
  764.         tmp := tmp + 256;
  765.       end;
  766.     cmd1byte (tmp mod 256); (* for all *)
  767.     end;
  768. end;
  769.  
  770.  
  771.  
  772. {---------------------------------------------------}
  773. function Tgetvaxbyte : OctByt;
  774. label 9999;
  775. begin
  776.   tfmbyte := tfmfile^;
  777.   if (tfmbyte < 0) then
  778.     Tgetvaxbyte := tfmbyte + 256
  779.   else 
  780.     Tgetvaxbyte := tfmbyte;
  781.   if (eof (tfmfile)) then
  782.     begin
  783.     complain (ERRREALBAD);
  784.     writeln (logfile,' early EOF of tfm file! ');
  785.     goto 9999;
  786.     end;
  787.   get (tfmfile);
  788. 9999:       
  789. end;
  790.  
  791.  
  792. {---------------------------------------------------}
  793. procedure readtfmword;
  794.  
  795. begin
  796.  
  797.   b0 := Tgetvaxbyte;
  798.   b1 := Tgetvaxbyte;
  799.   b2 := Tgetvaxbyte;
  800.   b3 := Tgetvaxbyte;
  801.  
  802. end; 
  803.  
  804.  
  805. {---------------------------------------------------}
  806. function DVaxByte : OctByt;
  807. label 99;
  808. begin
  809.   vaxbyt := dvifile^;
  810.   if (eof (dvifile)) then
  811.     begin
  812.     DVaxByte := 0;
  813.     goto 99;
  814.     end;
  815.   if (vaxbyt < 0) then
  816.     DVaxByte := vaxbyt + 256
  817.   else  
  818.     DVaxByte := vaxbyt;
  819.   get (dvifile);
  820. 99:     
  821. end;
  822.  
  823.  
  824.  
  825. {---------------------------------------------------}
  826. (* get a byte from the DVI file, but do not copy it into the DVIbuffer *)
  827. function Dgrabbyte : integer;
  828. var
  829.     b: OctByt;
  830. begin
  831.   if eof(dvifile) then 
  832.     Dgrabbyte := 0
  833.   else
  834.      begin
  835.  
  836.      b := DVaxByte;
  837.  
  838.      Dgrabbyte := b;
  839.      end;
  840. end;
  841.  
  842.  
  843. {---------------------------------------------------}
  844. function Dget1byte : integer;
  845. var
  846.     b: OctByt;
  847. begin
  848.     if eof(dvifile) then 
  849.     Dget1byte := 0
  850.     else
  851.      begin
  852.  
  853.      b := DVaxByte;
  854.  
  855.      Dget1byte := b
  856.     end;
  857.     cmd1byte(b);
  858. end;
  859.  
  860. {---------------------------------------------------}
  861. function Dsign1byte : integer;
  862. var
  863.     b: OctByt;
  864. begin
  865.  
  866.     b := DVaxByte;
  867.  
  868.     if b < 128 then 
  869.     Dsign1byte := b
  870.     else 
  871.     Dsign1byte := b - 256;
  872.     cmd1byte(b);
  873. end; 
  874.  
  875. {---------------------------------------------------}
  876. function Dget2byte : integer;
  877. var
  878.     a, b: OctByt;
  879. begin
  880.  
  881.     a := DVaxByte;
  882.     b := DVaxByte;
  883.  
  884.     Dget2byte := a * 256 + b;
  885.     cmd1byte(a);
  886.     cmd1byte(b);
  887. end;
  888.  
  889. {---------------------------------------------------}
  890. function Dsign2byte : integer;
  891. var
  892.     a, b: OctByt;
  893. begin
  894.  
  895.     a := DVaxByte;
  896.     b := DVaxByte;
  897.  
  898.     if a < 128 then 
  899.     Dsign2byte := a * 256 + b
  900.     else 
  901.     Dsign2byte := (a - 256) * 256 + b;
  902.     cmd1byte(a);
  903.     cmd1byte(b);
  904. end;
  905.  
  906. {---------------------------------------------------}
  907. function Dget3byte : integer;
  908. var
  909.     a, b, c: OctByt;
  910. begin
  911.  
  912.     a := DVaxByte;
  913.     b := DVaxByte;
  914.     c := DVaxByte;
  915.  
  916.     Dget3byte := (a * 256 + b) * 256 + c;
  917.     cmd1byte(a);
  918.     cmd1byte(b);
  919.     cmd1byte(c);
  920. end;
  921.  
  922. {---------------------------------------------------}
  923. function Dsign3byte : integer;
  924. var
  925.     a, b, c: OctByt;
  926. begin
  927.  
  928.     a := DVaxByte;
  929.     b := DVaxByte;
  930.     c := DVaxByte;
  931.  
  932.     if a < 128 then 
  933.     Dsign3byte := (a * 256 + b) * 256 + c
  934.     else 
  935.     Dsign3byte := ((a - 256) * 256 + b) * 256 + c;
  936.     cmd1byte(a);
  937.     cmd1byte(b);
  938.     cmd1byte(c);    
  939. end;
  940.  
  941. {---------------------------------------------------}
  942. function Dsign4byte : integer;
  943. var
  944.     a, b, c, d: OctByt;
  945. begin
  946.  
  947.     a := DVaxByte;
  948.     b := DVaxByte;
  949.     c := DVaxByte;
  950.     d := DVaxByte;
  951.  
  952.     if a < 128 then 
  953.     Dsign4byte := ((a * 256 + b) * 256 + c) * 256 + d
  954.     else 
  955.     Dsign4byte := (((a - 256) * 256 + b) * 256 + c) * 256 + d;
  956.     cmd1byte(a);
  957.     cmd1byte(b);
  958.     cmd1byte(c);
  959.     cmd1byte(d);    
  960. end;
  961.  
  962.  
  963. {---------------------------------------------------}
  964. (* write a byte out to the ouput file, but if we
  965.  * encounter the font flag, define the new fonts, and
  966.  * continue
  967.  *)
  968. procedure OutputByte (b : OctByt);
  969. var x : Inbyt;
  970.     n : integer;
  971. begin
  972.    n := b;
  973.    if (n = OURFONTFLAG) then
  974.      begin    (* our special macro-flag *)
  975.      n := NOP; (* nullify it *)
  976.      if (not didnewfonts) then
  977.        begin
  978.        didnewfonts := true;       
  979.        defineNewfonts; (* expand the defns in the outfile itself *)
  980.        end;
  981.      end;  (* if *)
  982.  
  983.     if (n > 127) then
  984.       begin
  985.       x := n - 256;
  986.       end
  987.     else
  988.       x := n;
  989.     outputfil^ := x;
  990.     put (outputfil);
  991.  
  992.   TotBytesWritten := TotBytesWritten + 1;  (* keep count of all bytes *)
  993. end;
  994.  
  995. {---------------------------------------------------} 
  996. procedure Output2Byte (i : integer);
  997. begin
  998.   OutputByte (i div 256);
  999.   OutputByte (i mod 256);
  1000. end;
  1001.  
  1002. {---------------------------------------------------}  
  1003. procedure Output4Byte (i : integer);
  1004. var tmp : integer;
  1005. begin
  1006.   tmp := i;
  1007.   if (tmp >= 0) then
  1008.     begin
  1009.     OutputByte (tmp div TWO24);
  1010.     end
  1011.   else
  1012.     begin
  1013.     tmp := tmp + TWO31 + 1; (* need the +1 *)
  1014.     OutputByte (tmp div TWO24 + 128);
  1015.     end; 
  1016.   tmp := tmp mod TWO24;
  1017.   OutputByte (tmp div TWO16);
  1018.   tmp := tmp mod TWO16;
  1019.   OutputByte (tmp div 256);
  1020.   OutputByte (tmp mod 256);
  1021. end;
  1022.  
  1023.  
  1024. {---------------------------------------------------}
  1025.  
  1026. function rtan (ang : real) : real;
  1027. var rads : real;
  1028.     cosrads : real;
  1029. begin
  1030.   rads := ang * DEGTORAD;
  1031.   cosrads := cos (rads);
  1032.   if (cosrads = 0.0) then  { this happens at 90 and 270 }
  1033.     cosrads := cos ((ang - 0.01) * DEGTORAD);
  1034.   rtan := (sin (rads)) / (cosrads);
  1035. end;
  1036.  
  1037. {---------------------------------------------------}
  1038. function float (i : integer) : real;
  1039. begin
  1040.   float := i + 0.00;
  1041. end;
  1042.  
  1043.  
  1044. {---------------------------------------------------}
  1045. function tolowercase (let: char) : char;
  1046. const Diff = 32; (* xord['a'] - xord['A'] *)
  1047. var olet : integer;
  1048. begin
  1049.  olet := xord[let];
  1050.  if (olet >= xord['A']) then
  1051.     begin
  1052.     if (olet <= xord['Z']) then
  1053.       begin
  1054.       let := xchr[olet + Diff];
  1055.       end;
  1056.     end;
  1057.  tolowercase := let;
  1058. end;
  1059.  
  1060. {---------------------------------------------------}
  1061. (* decide if the first string is the same as the second --
  1062.  * at least the first 'len' characters 
  1063.  *       We need this since most Pascal impls. are brain-dead
  1064.  *       when it comes to string comparisons     
  1065.  *)
  1066. function streq (a, b : charstring; len : integer) : boolean;
  1067. label 1;
  1068. var i : integer;
  1069.     same : boolean;
  1070. begin
  1071.   same := true;
  1072.   for i := 1 to len do
  1073.     begin
  1074.     if (a[i] <> b[i]) then
  1075.       begin
  1076.       same := false;
  1077.       goto 1;
  1078.       end;  (* if *)
  1079.     end;  (* for *)
  1080. 1: 
  1081.    streq := same;  
  1082. end;  (* streq *)
  1083.  
  1084. {-------------------------------------------------------}
  1085. procedure strcopy (* src : charstring; var dest : charstring; len : integer *);
  1086. var i : integer;
  1087.   begin
  1088.   for i := 1 to len do
  1089.     dest[i] := src[i];
  1090.   end;  
  1091.  
  1092. {-------------------------------------------------------}
  1093. procedure writestrng (* s :strng; tologfile : boolean *);
  1094. var i : integer;
  1095. begin
  1096. if (tologfile) then
  1097.   begin
  1098.   for i := 1 to s.len do
  1099.     write (logfile, s.str[i]);
  1100.   end
  1101. else
  1102.   begin
  1103.   for i := 1 to s.len do
  1104.     write (s.str[i]);
  1105.   end;
  1106. end;
  1107.  
  1108.  
  1109. {---------------------------------------------------}
  1110. (* Move the current DVI position to posx, posy by 
  1111.  * moving relatively from our current position
  1112.  * and store the new position 
  1113.  *)
  1114.  
  1115. procedure isetpos (posx, posy : integer);
  1116. var dy, dx: ScaledPts;
  1117.     numbytes : integer;
  1118. begin
  1119.    dx := posx - ourxpos;
  1120.    dy := posy - ourypos;
  1121.  
  1122.    numbytes := 1;
  1123.    if ((dx < 128) and (dx >= -128)) then
  1124.       numbytes := 1
  1125.    else if ((dx < 32768) and (dx >= -32768)) then
  1126.       numbytes := 2
  1127.    else if ((dx < TWO23) and (dx >= - TWO23))then
  1128.       numbytes := 3
  1129.    else if ((dx < TWO31) and (dx >= - TWO31))then
  1130.       numbytes := 4
  1131.    else
  1132.       begin
  1133.       complain (ERRREALBAD);
  1134.       writeln('Panic: dx is too big/small in isetpos: ',dx);
  1135.       writeln(logfile,'Panic: dx is too big/small in isetpos: ',dx);
  1136.       end;
  1137.   
  1138.    cmd1byte (RIGHTLEFT + numbytes -1); (* number of bytes in its arg list *)
  1139.    cmdSigned (dx, numbytes);
  1140.     
  1141.    numbytes := 1;
  1142.    if ((dy < 128) and (dy >= -128)) then
  1143.       numbytes := 1
  1144.    else if ((dy < 32768) and (dy >= -32768)) then
  1145.       numbytes := 2
  1146.    else if ((dy < TWO23) and (dy >= - TWO23))then
  1147.       numbytes := 3
  1148.    else if ((dy < TWO31) and (dy >= - TWO31))then
  1149.       numbytes := 4
  1150.    else
  1151.       begin
  1152.       complain (ERRREALBAD);
  1153.       writeln('Panic: dy is too big/small in isetpos: ',dy);
  1154.       writeln(logfile,'Panic: dy is too big/small in isetpos: ',dy);
  1155.       end;
  1156.   
  1157.    cmd1byte (DOWNUP + numbytes -1);
  1158.   
  1159.    cmdSigned (dy, numbytes);
  1160.   
  1161.    ourxpos := posx;
  1162.    ourypos := posy;
  1163. end;
  1164.  
  1165. {---------------------------------------------------}
  1166. (* put out a character *)
  1167. procedure iputchar (charno : OctByt);
  1168. begin
  1169.   cmd1byte (PUT1);
  1170.   cmd1byte (charno);
  1171. end;
  1172.  
  1173.  
  1174. {---------------------------------------------------}
  1175. (* set the font number, but only if it is different than
  1176.  * the last one we accessed.
  1177.  *)
  1178. procedure isetfont (DVINum : integer);
  1179. begin
  1180.   if (ourfontnum <> DVINum) then
  1181.     begin
  1182.     cmd1byte (USEFONT);
  1183.     cmd2byte (DVINum);
  1184.     ourfontnum := DVINum;
  1185.     end;
  1186. end;
  1187.  
  1188.  
  1189. procedure IPUSH;
  1190. begin
  1191.   if (ourpushdepth = 0) then
  1192.     begin   (* first push --> start tyling *)
  1193.     origTexfont := font[curfont].num;
  1194.     end
  1195.   else
  1196.     begin
  1197.     prevfont := ourfontnum; (* store the internal font number in use at this time *)
  1198.     end;
  1199.   cmd1byte (NOP);
  1200.   cmd1byte (NOP); (* our greeting *)  
  1201.   cmd1byte (PUSH);
  1202.   ourpushdepth := ourpushdepth + 1;
  1203. end;  
  1204.  
  1205. procedure IPOP;
  1206. begin
  1207.   cmd1byte (POP);
  1208.   cmd1byte(NOP);
  1209.   cmd1byte(NOP); (* our signature *)
  1210.   ourpushdepth := ourpushdepth - 1;
  1211.   if (ourpushdepth < 0) then
  1212.     begin
  1213.     complain (ERRREALBAD);
  1214.     writeln(logfile,'Error: too many internal pops');
  1215.     end;
  1216.   if (ourpushdepth = 0) then
  1217.     begin (* we are totally done with tyling for now *)
  1218.     if (nf > 0) then
  1219.       isetfont (origTexfont); (* only if it is valid *)
  1220.     end
  1221.   else
  1222.     begin
  1223.     if (prevfont >= 0) then 
  1224.       isetfont(prevfont);     (* restore that internal font previously in use *)
  1225.     end;
  1226. end;  
  1227.  
  1228. {---------------------------------------------------}
  1229. (* Assumes that the correct font is currently set *)
  1230. procedure Tyldot (dotx, doty : ScaledPts);
  1231. begin
  1232.   if (dotx <> 0) and (doty <> 0) then
  1233.     isetpos (dotx, doty);
  1234.   iputchar (DOTCHAR);
  1235. end;  
  1236.  
  1237. {---------------------------------------------------}
  1238. procedure InitDVIBuf;
  1239. var i: integer;
  1240. begin
  1241.   with GDVIBuf do
  1242.     begin
  1243.     TotByteLen := 0;
  1244.     Numstrings := 0;
  1245.     for i := 1 to MAXDVISTRINGS do
  1246.       Dstrings[i] := nil;
  1247.     curstrindex := MAXOLEN + 1;
  1248.     end; 
  1249. end;
  1250.  
  1251. {---------------------------------------------------}
  1252. procedure ClearDVIBuf;
  1253. var i : integer;
  1254. begin
  1255.   with GDVIBuf do
  1256.     begin
  1257.     for i := 1 to Numstrings do
  1258.       begin
  1259.       dispose (Dstrings[i]);
  1260.       Dstrings[i] := nil;
  1261.       end;
  1262.     TotByteLen := 0;
  1263.     Numstrings := 0;
  1264.     curstrindex := MAXOLEN + 1;
  1265.     end; 
  1266. end;
  1267.  
  1268. {---------------------------------------------------}
  1269. procedure WriteDVIBuf;
  1270. var i: integer;
  1271.     curstr: integer;
  1272.     b : OctByt;
  1273. begin
  1274.   curstr := 1;
  1275.   with GDVIBuf do
  1276.     begin
  1277.     while (curstr < Numstrings) do
  1278.       begin
  1279.       for i := 1 to MAXOLEN do
  1280.         begin
  1281.           b := Dstrings[curstr]^[i];
  1282.           OutputByte (b);       
  1283.         end;
  1284.       curstr := curstr + 1;
  1285.       end; (* while *)
  1286.  
  1287. (* now do the last string *)
  1288.    for i := 1 to (curstrindex - 1) do
  1289.      begin
  1290.        b := Dstrings[Numstrings]^[i];
  1291.        OutputByte(b);
  1292.      end;  (* for *)
  1293.     end;  (* with *)
  1294.   ClearDVIBuf;
  1295. end;
  1296.  
  1297. {---------------------------------------------------}
  1298. procedure BackupInBuf (nbytes : integer);
  1299. var nstrs, rem : integer;
  1300. begin
  1301.   with GDVIBuf do
  1302.     begin
  1303.     nstrs := (TotByteLen - nbytes) div MAXOLEN;
  1304.     rem :=  (TotByteLen - nbytes) mod MAXOLEN;
  1305.     Numstrings :=  nstrs + 1;
  1306.     curstrindex := rem + 1; (* points to position to-be-filled *)
  1307.     if (curstrindex = 0) then 
  1308.        curstrindex := MAXOLEN;
  1309.     TotByteLen := TotByteLen - nbytes;
  1310.     end; 
  1311. end;
  1312.  
  1313. {-----------------------------------------------------}
  1314. function DVIMark : integer;
  1315. begin
  1316.   DVIMark := GDVIBuf.TotByteLen;
  1317. end;  
  1318.  
  1319.  
  1320.  
  1321. {---------------------------------------------}
  1322. function NewItem (what : Primitive): pItem;
  1323. var i : pItem;
  1324.     f : figptr;
  1325. begin
  1326.  
  1327.  new (i);
  1328.  with i^ do 
  1329.    begin
  1330.    nextitem := nil;
  1331.    BBlx := 0;
  1332.    BBby := 0;
  1333.    BBrx := 0;
  1334.    BBty := 0;
  1335.    itemthick := LoVThick;
  1336.    itemvec := VKCirc;
  1337.    itempatt := solid;
  1338.    kind := what;
  1339.    case (what) of          (* give defaults *)
  1340.      Aline : ;
  1341.      Aspline:    begin
  1342.         nsplknots := 0;
  1343.         dosmarks := 0;
  1344.         sclosed := false;
  1345.         spltype := BSPL;
  1346.         end;
  1347.      Attspline:    begin
  1348.         nttknots := 0;
  1349.         dottmarks := 0;
  1350.         tspltype := BSPL;
  1351.         tclosed := false;
  1352.         end;
  1353.      Abeam : ;
  1354.      Atieslur:    begin
  1355.         ntknots := 0;
  1356.         end;
  1357.      Aarc:    begin
  1358.         narcknots := 0;
  1359.         end;         
  1360.      Alabel:    begin
  1361.              fontstyle := -1; (* undefined *)
  1362.         labeltext.len := 0;
  1363.         end;
  1364.      Afigure:    begin    
  1365.         figtheta := 0.0;
  1366.         fsx := 1.0;     fsy := 1.0;
  1367.         fdx := 0;       fdy := 0;
  1368.         preWid := 0;    preHt := 0;
  1369.         postWid := 0;   postHt := 0;
  1370.         depthnumber := 0; (* for now *)
  1371.         new (f); (* a new figure *)
  1372.         body := f;
  1373.         body^.things := nil;
  1374.         end;
  1375.      end; (*case *)
  1376.    end;  (* with *)
  1377.  NewItem := i;
  1378. end;  (* NewItem *)
  1379.  
  1380. { ### Note: "pageitems" could be extended to be a list
  1381. { of macrodefinitions which contain primitives , and
  1382. { then could be instanced.  E.g., a library of common
  1383. { figures callable from \special level }
  1384.  
  1385.  
  1386. {------------------------------------------------------}
  1387. procedure pushItem (depth : integer; newthing : pItem);
  1388. label 101;
  1389. var i, p : pItem;
  1390.     dun : boolean;
  1391. begin
  1392.   if (pageitems = nil) then
  1393.     begin
  1394.     if (newthing^.kind = Afigure) then
  1395.       begin
  1396.       pageitems := newthing;
  1397.       goto 101;
  1398.       end
  1399.     else
  1400.       begin
  1401.       pageitems := NewItem (Afigure);
  1402.       pageitems^.depthnumber := depth;
  1403.       end;
  1404.     end;
  1405.   
  1406.   (* Assume that pageitems points to Afigure *)
  1407.  
  1408.       (* traverse the list *)
  1409.       i := pageitems; (* point to front of list for now *)
  1410.       p := i^.body^.things; 
  1411.       dun := false;
  1412.       while ((p <> nil) and not dun) do
  1413.         begin
  1414.         if (depth = i^.depthnumber) then
  1415.           begin (* simple push *)
  1416.           dun := true;
  1417.           (* Note: this is the case when pushing another figure item
  1418.                 onto an already-existing list. We push the newfigure
  1419.                 with a depth of (fig^.depthnumber - 1) because it
  1420.                 really is part of the higer-level figure
  1421.            *)
  1422.           end
  1423.         else if (depth > i^.depthnumber) then   
  1424.           begin
  1425.           (* there MUST be a figure with a higher number deeper *)
  1426.           while ((p^.kind <> Afigure) and (p^.nextitem <> nil)) do
  1427.             begin
  1428.             p := p^.nextitem;
  1429.             end;
  1430.  
  1431.           if (p^.kind = Afigure) then
  1432.             begin
  1433.             i := p;
  1434.             p := i^.body^.things;
  1435.             end
  1436.           else
  1437.         begin
  1438.         complain (ERRREALBAD);
  1439.             writeln(logfile,'OOPS p^.kind isnt a figure. It must be near endoflist');
  1440.         end;
  1441.           end;
  1442.         end;  (* while *)
  1443.  
  1444.       (* we have the correct front of list-list,
  1445.          and i points to Afigure item *)
  1446.       newthing^.nextitem := p;
  1447.       i^.body^.things := newthing;
  1448. 101:
  1449. end;  (*  pushItem *)
  1450.  
  1451.  
  1452.  
  1453. {---------------------------------------------}
  1454. function Tgetfixword (k: integer) : real;
  1455. var a : 0 .. 4096;
  1456.     f : integer;
  1457. begin
  1458.   a := (tfm[k] * 16) + (tfm[k + 1] div 16);
  1459.   f := ((((tfm[k + 1] mod 16) * 256)
  1460.          + tfm[k + 2]) * 256)
  1461.          + tfm[k + 3];
  1462.   if (a > 2047) then
  1463.     begin
  1464.     a := 4096 - a;
  1465.     if (f > 0) then
  1466.       begin
  1467.       f := TWO20 - f;
  1468.       a := a - 1;
  1469.       end;
  1470.     end;
  1471.   Tgetfixword := a + f / TWO20;
  1472. end;
  1473.  
  1474. {-----------------------------------------------------}
  1475. function TgetSigned (k: integer): integer;
  1476. var i: integer;
  1477. begin 
  1478.   i := tfm[k];
  1479.   if (i < 128) then
  1480.     i := i - 256;
  1481.   TgetSigned := (((((i * 256) + tfm[k + 1]) * 256) +
  1482.                         tfm[k + 2]) * 256) + tfm[k + 3];
  1483. end;
  1484.  
  1485.  
  1486.  
  1487. {-----------------------------------------------------------}
  1488. (* open a .tfm file and return the parameters in it.  
  1489.  * Used only in conjuction with the vector and music fonts 
  1490.  *)
  1491. procedure gettfm (tfmfilnam: strng; 
  1492.                   var dessize, p1, p2, p3, p4, p5, p6, p7 : ScaledPts;
  1493.                   var cksum : integer);
  1494. label 9999;
  1495. var tfmptr: integer;
  1496.     lf, lh, bc, ec, nw, nh, nd, ni, nl, nk, ne, np: integer;
  1497.     charbase, widthbase, heightbase, depthbase,
  1498.     italicbase, ligkernbase, kernbase, extenbase,
  1499.     parambase : integer;
  1500.     tempdesignsize : ScaledPts;
  1501. begin
  1502.   p1 := 0; p2 := 0; p3 := 0; p4 := 0;
  1503.   p5 := 0; p6 := 0; p7 := 0;
  1504.   cksum := -1;
  1505.  
  1506.   strcopy(tfmfilnam.str,  tfmname.str, tfmfilnam.len);
  1507.   tfmname.len := tfmfilnam.len;
  1508.  
  1509.   tfmname.str[tfmname.len + 1] := chr(32);
  1510.  
  1511.   if (not opentfmfile) then
  1512.     begin
  1513.       complain (ERRREALBAD);
  1514.       writestrng(tfmname,true);
  1515.       writeln(logfile,'---not loaded, TFM file can''t be opened!');
  1516.       writestrng(tfmname,false);
  1517.       writeln(' cannot be opened. Aborting');
  1518.       jumpout;
  1519.     end;
  1520.  
  1521.  
  1522.   tfm[0] := Tgetvaxbyte;
  1523.   tfm[1] := Tgetvaxbyte;
  1524.  
  1525.  
  1526.   lf := (tfm[0] * 256) + tfm[1];
  1527.   if ((4 * lf - 1) > TFMSIZE) then 
  1528.     begin
  1529.     complain (ERRREALBAD);
  1530.     write(logfile,'The tfm file:');
  1531.     writestrng(tfmfilnam, true);
  1532.     writeln(logfile,' is bigger than I can handle!');
  1533.     goto 9999;
  1534.     end;
  1535.  
  1536.   for tfmptr := 2 to (4 * lf) - 1 do 
  1537.     begin
  1538.  
  1539.     tfm[tfmptr] := Tgetvaxbyte;
  1540.  
  1541.     end; (* for *)
  1542.  
  1543.   tfmptr := 2;
  1544.   lh := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1545.   tfmptr := tfmptr + 2;
  1546.  
  1547.   bc := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1548.   tfmptr := tfmptr + 2;
  1549.  
  1550.   ec := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1551.   tfmptr := tfmptr + 2;
  1552.  
  1553.   nw := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1554.   tfmptr := tfmptr + 2;
  1555.  
  1556.   nh := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1557.   tfmptr := tfmptr + 2;
  1558.  
  1559.   nd := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1560.   tfmptr := tfmptr + 2;
  1561.  
  1562.   ni := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1563.   tfmptr := tfmptr + 2;
  1564.  
  1565.   nl := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1566.   tfmptr := tfmptr + 2;
  1567.  
  1568.   nk := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1569.   tfmptr := tfmptr + 2;
  1570.  
  1571.   ne := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1572.   tfmptr := tfmptr + 2;
  1573.  
  1574.   np := (tfm[tfmptr] * 256) + tfm[tfmptr + 1];
  1575.   tfmptr := tfmptr + 2;
  1576.  
  1577.   if (lf <> (6 + lh + ((ec - bc) + 1) + nw + nh
  1578.                           + nd + ni + nl + nk + ne + np)) then 
  1579.     begin
  1580.       complain (ERRREALBAD);
  1581.       writestrng(tfmfilnam, true);
  1582.       writeln(logfile,': subfile sizes don''t add up to the stated total!');
  1583.       writeln(logfile,'Sorry, but I can''t go on; are you sure this is a TFM?');
  1584.       goto 9999
  1585.     end;
  1586.   if (bc > (ec + 1)) or (ec > 255) then 
  1587.     begin
  1588.       complain (ERRREALBAD);
  1589.       writeln(logfile,'The character code range ', bc: 1, '..', ec: 1, 'is illegal!');
  1590.       writeln(logfile,'Sorry, but I can''t go on; are you sure this is a TFM?');
  1591.       goto 9999;
  1592.     end;
  1593.   charbase := (6 + lh) - bc;
  1594.   widthbase := (charbase + ec) + 1;
  1595.   heightbase := widthbase + nw;
  1596.   depthbase := heightbase + nh;
  1597.   italicbase := depthbase + nd;
  1598.   ligkernbase := italicbase + ni;
  1599.   kernbase := ligkernbase + nl;
  1600.   extenbase := kernbase + nk;
  1601.   parambase := (extenbase + ne) - 1;
  1602.  
  1603.   dessize := round (Tgetfixword (28) * SPPERPT); (* now in ScaledPts *)
  1604.   tempdesignsize := round (dessize * magfactor);
  1605.   cksum := TgetSigned (24);
  1606.           (* return the special 7 parameters for the  font *)
  1607.   p1 := round (Tgetfixword (4 * (parambase + 1)) * tempdesignsize);
  1608.   p2 := round (Tgetfixword (4 * (parambase + 2)) * tempdesignsize);
  1609.   p3 := round (Tgetfixword (4 * (parambase + 3)) * tempdesignsize);
  1610.   p4 := round (Tgetfixword (4 * (parambase + 4)) * tempdesignsize);
  1611.   p5 := round (Tgetfixword (4 * (parambase + 5)) * tempdesignsize);
  1612.   p6 := round (Tgetfixword (4 * (parambase + 6)) * tempdesignsize);
  1613.   p7 := round (Tgetfixword (4 * (parambase + 7)) * tempdesignsize);
  1614.  
  1615. 9999:
  1616. end;
  1617.  
  1618.  
  1619. {---------------------------------------------------}
  1620. procedure initVnMnLtables;
  1621. var i: integer;
  1622. begin
  1623.   for i := 1 to SizVFontTable do
  1624.     VFontTable[i] := nil;
  1625.   for i := 1 to SizMFontTable do
  1626.     MFontTable[i] := nil;
  1627.   for i := 1 to SizLFontTable do
  1628.     LFontTable[i] := nil;
  1629.   VFontsDefd := 0;
  1630.   MFontsDefd := 0;
  1631.   LFontsDefd := 0;
  1632.   GDVIFN := 300; (* starting number for any new fonts that we define *)
  1633. end; 
  1634.  
  1635.  
  1636. {-------------------------------------------------------}
  1637. procedure fonttobedefined (kind : char; findex : integer);
  1638. begin
  1639.   FTBDs := FTBDs + 1;  
  1640. (* reset this to zero after outputting
  1641.    1. fontdefs
  1642.    2. bop
  1643.    3. contents of dvi page
  1644.    4. eop
  1645. *)
  1646.   TBD[FTBDs].which := kind;
  1647.   TBD[FTBDs].indx := findex;
  1648. end;
  1649.  
  1650.  
  1651. {-----------------------------------------------------}
  1652. procedure enterfont (fontnum : integer; ck : integer;
  1653.                      scalefact, dessiz : ScaledPts;
  1654.                      nam : strng);
  1655. var n: integer;
  1656.     len : integer;
  1657. begin
  1658.   cmd1byte(FONTDEF);
  1659.   cmd2byte(fontnum);
  1660.   cmd4byte(ck);
  1661.   cmd4byte(scalefact);
  1662.   cmd4byte(dessiz);
  1663.   cmd1byte(USESTDAREA);
  1664.  
  1665.   len := nam.len;
  1666.  
  1667.  
  1668.   cmd1byte(len - 4); (* skip the length of the .tfm suffix *)
  1669.  
  1670.  
  1671.   for n := 1 to (nam.len - 4) do    
  1672.  
  1673.     begin (* skip the .tfm suffix *)
  1674.     cmd1byte (xord [ nam.str[n] ]);
  1675.     end;
  1676. end;
  1677.  
  1678.  
  1679. {-----------------------------------------------------}
  1680. procedure Outputfont (fontnum : integer; ck : integer;
  1681.                      scalefact, dessiz : ScaledPts;
  1682.                      nam : strng);
  1683. var n: integer;
  1684.     len : integer;
  1685. begin
  1686.   OutputByte(FONTDEF);
  1687.   Output2Byte(fontnum);
  1688.   Output4Byte(ck);
  1689.   Output4Byte(scalefact);
  1690.   Output4Byte(dessiz);
  1691.   OutputByte(USESTDAREA);
  1692.  
  1693.   len := nam.len;
  1694.  
  1695.  
  1696.   OutputByte(len - 4);
  1697.  
  1698.  
  1699.   for n := 1 to (nam.len - 4) do    
  1700.  
  1701.     begin (* dont output the default dir prefix, nor the .tfm suffix *)
  1702.     OutputByte(xord [ nam.str[n] ]);
  1703.     end;
  1704. end;
  1705.  
  1706. {-----------------------------------------------------}
  1707. procedure defineNewfonts;
  1708. (* this needs to be done before first access to a font on a page
  1709.   later someone else will have to re-define all of them in the postamble *)
  1710. label 99;
  1711. var i, n : integer;
  1712.     f : integer;
  1713. begin
  1714.   for i := 1 to FTBDs do
  1715.     begin
  1716.     if (TBD[i].which = 'V') then
  1717.       begin
  1718.       f := TBD[i].indx;
  1719.       with VFontTable[f]^ do  
  1720.         begin
  1721.         if (Isdefined) then
  1722.          goto 99;
  1723.         Outputfont (DVIFontNum, Cksum, DesSize, DesSize, 
  1724.                         FontName);
  1725.         Isdefined := true;
  1726.         end; (*with *)
  1727.       end (* if *)
  1728.     else if (TBD[i].which = 'M') then
  1729.       begin (* music font *)
  1730.       f := TBD[i].indx;
  1731.       with MFontTable[f]^ do
  1732.         begin
  1733.         if (Isdefined) then
  1734.          goto 99;
  1735.         Outputfont (DVIFontNum, Cksum, DesSize, DesSize,
  1736.                         FontName);
  1737.         Isdefined := true;
  1738.         end; (* with *)
  1739.       end (* else *)
  1740.     else if (TBD[i].which = 'L') then
  1741.       begin (* label font *)
  1742.       f := TBD[i].indx;
  1743.       with LFontTable[f]^ do
  1744.     begin
  1745.     if (Isdefined) then
  1746.       goto 99;
  1747.     Outputfont (DVIFontNum, Cksum, DesSize, DesSize, {### is this right?}
  1748.             FontName);
  1749.     Isdefined := true;
  1750.     end;  (* with *)
  1751.       end 
  1752.     else
  1753.       begin
  1754.       complain (ERRREALBAD);
  1755.       writeln(logfile,'Unknown type of font to be defined:"',TBD[i].which,'"');
  1756.       end;  (* else *)
  1757. 99:
  1758.     end; (* for *)
  1759. end; 
  1760.  
  1761.  
  1762. {---------------------------------------------------}
  1763. function GetMusFont (stfsiz, fam : integer) : MusIndex;
  1764. label 20, 99;
  1765. var mustfmnam : strng;
  1766.     found, i : MusIndex;
  1767.     design, p1, p2, p3, p4, linesp, gwidth, p7 : ScaledPts;
  1768.     cksm, r, k : integer;
  1769. begin
  1770.   (* see if it already exists *)
  1771.   found := 0;
  1772.   for i := 1 to MFontsDefd do  (* loop through since there are few *)
  1773.     with MFontTable[i]^ do
  1774.       begin
  1775.       if (Staffsize = stfsiz) and
  1776.          (Family = fam) then
  1777.          begin
  1778.          found := i;
  1779.          goto 20;
  1780.          end;
  1781.       end; (* with *)
  1782.   
  1783. 20: if (found <> 0) then
  1784.      begin
  1785.      GetMusFont := found;
  1786.      goto 99;
  1787.      end;
  1788.     
  1789.     (* Not here already--go get it *)
  1790.     for k := 1 to ARRLIMIT do
  1791.       mustfmnam.str[k] := ' ';
  1792.  
  1793.     r := 0;
  1794.  
  1795.     mustfmnam.str[r+1] := 'm';
  1796.     mustfmnam.str[r+2] := 'u';
  1797.     mustfmnam.str[r+3] := 's';
  1798.     mustfmnam.str[r+4] := xchr[stfsiz + xord['0']];
  1799.     mustfmnam.str[r+5] := xchr[fam + xord['0']];
  1800.     mustfmnam.str[r+6] := '.';
  1801.     mustfmnam.str[r+7] := 't';
  1802.     mustfmnam.str[r+8] := 'f';
  1803.     mustfmnam.str[r+9] := 'm';    
  1804.  
  1805.     mustfmnam.str[r+10] := chr(32);
  1806.  
  1807.     mustfmnam.len := 9 + r;
  1808.     gettfm (mustfmnam, design, p1, p2, p3, p4, linesp, gwidth, p7, cksm);
  1809.  
  1810.     MFontsDefd := MFontsDefd + 1;
  1811.    if (MFontsDefd > SizMFontTable) then
  1812.      begin
  1813.        complain (ERRREALBAD);
  1814.        writestrng(mustfmnam, true);
  1815.        writeln(logfile,'---not loadable. Size of Music Font table too small');
  1816.        writestrng(mustfmnam,false);
  1817.        writeln(' cannot be loaded. Too many music fonts. Table too small.');
  1818.        jumpout;
  1819.      end;
  1820.  
  1821.     i := MFontsDefd;
  1822.     new (MFontTable[i]);
  1823.     with MFontTable[i]^ do
  1824.       begin
  1825.       Staffsize := stfsiz;    
  1826.       Family := fam;
  1827.       DesSize := design;
  1828.       strcopy (mustfmnam.str, FontName.str, mustfmnam.len);
  1829.       FontName.len := mustfmnam.len;
  1830.       Cksum := cksm;
  1831.       ghu := round (gwidth / QNOTEGHUS);
  1832.       gvu := round (linesp / QNOTEGVUS);
  1833.       DVIFontNum := GDVIFN + 1;
  1834.       Isdefined := false;
  1835.       end;
  1836.  
  1837.     GDVIFN := GDVIFN + 1;
  1838. (* call someone to do the defns of cdp, cht, cwd foreach beam *)      
  1839.     definebeams (MFontTable[i]);
  1840.     fonttobedefined ('M', i);
  1841.     GetMusFont := i;
  1842. 99:    
  1843. end; 
  1844.  
  1845.  
  1846. {---------------------------------------------------}
  1847. function GetVectFont (size : VThickness; vk : VectKind) : VecIndex;
  1848. label 20, 99;
  1849. var vectfmnam : strng;
  1850.     found, i : VecIndex;
  1851.     design, p1, p2, w0, w1, maxveclen, p6, p7 : ScaledPts;
  1852.     cksm, r, k : integer;
  1853. begin
  1854.   (* see if it already exists *)
  1855.   found := 0;
  1856.  
  1857.   for i := 1 to VFontsDefd do
  1858.    with VFontTable[i]^ do
  1859.     begin
  1860.     if ((psize = size) and
  1861.         (vkind = vk)) then
  1862.        begin
  1863.        found := i;
  1864.        goto 20;
  1865.        end;
  1866.     end; (* with *)
  1867.     
  1868. 20:
  1869.   if (found <> 0) then
  1870.    begin
  1871.      GetVectFont := found;
  1872.      goto 99;
  1873.    end;
  1874.     
  1875.     (* Not here--go get it *)
  1876.     for k := 1 to ARRLIMIT do
  1877.       vectfmnam.str[k] := ' ';
  1878.  
  1879.     r := 0;
  1880.  
  1881.     case (vk) of
  1882.       VKCirc : vectfmnam.str[r+1] := 'c';
  1883.       VKVert : vectfmnam.str[r+1] := 'v';
  1884.       VKHort : vectfmnam.str[r+1] := 'h';
  1885.     end; (*case *)
  1886.     vectfmnam.str[r+2] := 'v';
  1887.     vectfmnam.str[r+3] := 'e';
  1888.     vectfmnam.str[r+4] := 'c';
  1889.      if (size <= 9) then
  1890.       begin
  1891.       vectfmnam.str[r+5] := xchr[size + xord['0']];
  1892.       vectfmnam.str[r+6] := '.';
  1893.       vectfmnam.str[r+7] := 't';
  1894.       vectfmnam.str[r+8] := 'f';
  1895.       vectfmnam.str[r+9] := 'm';
  1896.  
  1897.       vectfmnam.str[r+10] := chr(32);      
  1898.  
  1899.       vectfmnam.len := 9 + r;
  1900.       end
  1901.     else
  1902.       begin
  1903.       vectfmnam.str[r+5] := xchr[(size div 10) + xord['0']];
  1904.       vectfmnam.str[r+6] := xchr[(size - ((size div 10)*10)) + xord['0']];
  1905.       vectfmnam.str[r+7] := '.';
  1906.       vectfmnam.str[r+8] := 't';
  1907.       vectfmnam.str[r+9] := 'f';
  1908.       vectfmnam.str[r+10] := 'm';
  1909.  
  1910.       vectfmnam.str[r+11] := chr(32);      
  1911.  
  1912.       vectfmnam.len := 10 + r;
  1913.       end;
  1914.  
  1915.    gettfm (vectfmnam, design, p1, p2, w0, w1, maxveclen, p6, p7, cksm);
  1916.    VFontsDefd := VFontsDefd + 1;
  1917.    if (VFontsDefd > SizVFontTable) then
  1918.      begin
  1919.        complain (ERRREALBAD);
  1920.        writestrng(vectfmnam, true);
  1921.        writeln(logfile,'---not loadable. Size of Vector Font table too small');
  1922.        writestrng(vectfmnam,false);
  1923.        writeln(' cannot be loaded. Too many vector fonts. Table too small.');
  1924.        jumpout;
  1925.      end;
  1926.  
  1927.    i := VFontsDefd;
  1928.    new (VFontTable[i]);
  1929.    with VFontTable[i]^ do
  1930.      begin
  1931.      vkind := vk;
  1932.      psize := size;
  1933.      DesSize := design;
  1934.      if (vk = VKVert) then
  1935.        PenSize := w1    
  1936.      else
  1937.        PenSize := w0;
  1938.      PenSize := round (size * (MAXVECLENsp / 16.0));
  1939.      MaxVectLen := maxveclen;
  1940.      strcopy (vectfmnam.str, FontName.str, vectfmnam.len);
  1941.      FontName.len := vectfmnam.len;
  1942.      Cksum := cksm;
  1943.      Isdefined := false;
  1944.      DVIFontNum := GDVIFN + 1;
  1945.      end;
  1946.  
  1947.   GDVIFN := GDVIFN + 1;
  1948.  
  1949.   definevectors (VFontTable[i]);
  1950. (* someone asked for it, so they must want it, and we should fntdef it *)
  1951.   fonttobedefined ('V', i); 
  1952.   GetVectFont := i;
  1953. 99:
  1954. end;
  1955.  
  1956. {----------------------------------------------------------}
  1957. function GetLabFont (style : integer) : integer;
  1958. label 30, 99;
  1959. var labtfmnam : strng;
  1960.     found, i : integer;
  1961.     design, p1, space, p3, p4, p5, p6, p7 : ScaledPts;
  1962.     cksm, r, k : integer;
  1963. begin
  1964. if (style > MAXLABELFONTS) then
  1965.   style := 1;
  1966.   found := 0;
  1967.   for i := 1 to LFontsDefd do
  1968.     with LFontTable[i]^ do
  1969.       begin
  1970.       if (internalnumber = style) then
  1971.     begin
  1972.         found := i;
  1973.     goto 30;
  1974.     end;
  1975.       end; 
  1976. 30:
  1977.    if (found <> 0) then
  1978.      begin
  1979.      GetLabFont := found;
  1980.      goto 99;
  1981.      end;  
  1982.    for k := 1 to ARRLIMIT do
  1983.      labtfmnam.str[k] := ' ';
  1984.  
  1985.    r := 0;
  1986.  
  1987.    labtfmnam.str[r + 1] := 'c';
  1988.    labtfmnam.str[r + 2] := 'm';
  1989.    case style of
  1990.      1: begin        (* cmtt10 *)
  1991.         labtfmnam.str[r + 3] := 't';
  1992.         labtfmnam.str[r + 4] := 't';
  1993.         labtfmnam.str[r + 5] := '1';
  1994.         labtfmnam.str[r + 6] := '0';
  1995.     k := r + 6;
  1996.         end;
  1997.      2: begin        (* cmb10 *)
  1998.         labtfmnam.str[r + 3] := 'b';
  1999.         labtfmnam.str[r + 4] := '1';
  2000.         labtfmnam.str[r + 5] := '0';
  2001.     k := r + 5;
  2002.         end;
  2003.      3: begin        (* cmsl10 *)
  2004.         labtfmnam.str[r + 3] := 's';
  2005.         labtfmnam.str[r + 4] := 'l';
  2006.         labtfmnam.str[r + 5] := '1';
  2007.         labtfmnam.str[r + 6] := '0';
  2008.     k := r + 6;
  2009.         end;
  2010.      4: begin        (* cmtt8 *)
  2011.         labtfmnam.str[r + 3] := 't';
  2012.         labtfmnam.str[r + 4] := 't';
  2013.         labtfmnam.str[r + 5] := '8';
  2014.     k := r + 5;
  2015.         end;
  2016.      5: begin        (* cmsl8 *)
  2017.         labtfmnam.str[r + 3] := 's';
  2018.         labtfmnam.str[r + 4] := 'l';
  2019.         labtfmnam.str[r + 5] := '8';
  2020.     k := r + 5;
  2021.         end;
  2022.    end; (* case *)
  2023.   labtfmnam.str[k + 1] := '.';
  2024.   labtfmnam.str[k + 2] := 't';
  2025.   labtfmnam.str[k + 3] := 'f';
  2026.   labtfmnam.str[k + 4] := 'm';
  2027.  
  2028.   labtfmnam.str[k+5] := chr(32);
  2029.  
  2030.   labtfmnam.len := k + 4;
  2031.  
  2032.   gettfm (labtfmnam, design, p1, space, p3, p4, p5, p6, p7, cksm);
  2033.  
  2034.   LFontsDefd := LFontsDefd + 1;
  2035.  
  2036.   if (LFontsDefd > SizLFontTable) then
  2037.      begin
  2038.        complain (ERRREALBAD);
  2039.        writestrng(labtfmnam, true);
  2040.        writeln(logfile,'---not loadable. Size of Label Font table too small');
  2041.        writestrng(labtfmnam,false);
  2042.        writeln(' cannot be loaded. Too many label fonts. Table too small.');
  2043.        jumpout;
  2044.      end;
  2045.  
  2046.   i := LFontsDefd;
  2047.   new (LFontTable[i]);
  2048.   with LFontTable[i]^ do
  2049.     begin
  2050.     strcopy (labtfmnam.str, FontName.str, labtfmnam.len);
  2051.     FontName.len := labtfmnam.len;
  2052.     Cksum := cksm;
  2053.     DesSize := design;
  2054.     internalnumber := style;
  2055.     spacewidth := space;
  2056.     DVIFontNum := GDVIFN +1;
  2057.     Isdefined := false;
  2058.     end;  (* with *)
  2059.  
  2060.   GDVIFN := GDVIFN + 1;
  2061.   fonttobedefined ('L', i);
  2062.   GetLabFont := i;
  2063. 99:
  2064. end;  
  2065.     
  2066.  
  2067. {------------------------------------------------}
  2068. function vectangle (dx, dy : integer) :real;
  2069. begin
  2070.   if (dx <> 0) then
  2071.     vectangle := arctan (dy / (dx * 1.0)) * RADTODEG
  2072.   else
  2073.     begin
  2074.     if (dy > 0) then 
  2075.       vectangle := 90.0
  2076.     else
  2077.       vectangle := -90.0;
  2078.     end;
  2079. end;
  2080.  
  2081.  
  2082. {-----------------------------------------------------------}
  2083. procedure definevectors (* var Vec: pVectFontInfRec *);
  2084. var  units : real;
  2085. begin
  2086.   units := Vec^.MaxVectLen / 16.0;
  2087. with Vec^.FontInfo[  0] do begin
  2088.     Cht := round( 15.9688 * units);
  2089.     Cdp := 0;
  2090.     Cwd := round(  0.9981 * units);
  2091.     Angle :=   86.4237;
  2092. end;
  2093.  
  2094. with Vec^.FontInfo[  1] do begin
  2095.     Cht := round( 15.8764 * units);
  2096.     Cdp := 0;
  2097.     Cwd := round(  1.9846 * units);
  2098.     Angle :=   82.8750;
  2099. end;
  2100.  
  2101. with Vec^.FontInfo[  2] do begin
  2102.     Cht := round( 15.7260 * units);
  2103.     Cdp := 0;
  2104.     Cwd := round(  2.9486 * units);
  2105.     Angle :=   79.3803;
  2106. end;
  2107.  
  2108. with Vec^.FontInfo[  3] do begin
  2109.     Cht := round( 15.5223 * units);
  2110.     Cdp := 0;
  2111.     Cwd := round(  3.8806 * units);
  2112.     Angle :=   75.9638;
  2113. end;
  2114.  
  2115. with Vec^.FontInfo[  4] do begin
  2116.     Cht := round( 15.2717 * units);
  2117.     Cdp := 0;
  2118.     Cwd := round(  4.7724 * units);
  2119.     Angle :=   72.6460;
  2120. end;
  2121.  
  2122. with Vec^.FontInfo[  5] do begin
  2123.     Cht := round( 14.9813 * units);
  2124.     Cdp := 0;
  2125.     Cwd := round(  5.6180 * units);
  2126.     Angle :=   69.4440;
  2127. end;
  2128.  
  2129. with Vec^.FontInfo[  6] do begin
  2130.     Cht := round( 14.6585 * units);
  2131.     Cdp := 0;
  2132.     Cwd := round(  6.4131 * units);
  2133.     Angle :=   66.3706;
  2134. end;
  2135.  
  2136. with Vec^.FontInfo[  7] do begin
  2137.     Cht := round( 14.3108 * units);
  2138.     Cdp := 0;
  2139.     Cwd := round(  7.1554 * units);
  2140.     Angle :=   63.4349;
  2141. end;
  2142.  
  2143. with Vec^.FontInfo[  8] do begin
  2144.     Cht := round( 13.9452 * units);
  2145.     Cdp := 0;
  2146.     Cwd := round(  7.8442 * units);
  2147.     Angle :=   60.6422;
  2148. end;
  2149.  
  2150. with Vec^.FontInfo[  9] do begin
  2151.     Cht := round( 13.5680 * units);
  2152.     Cdp := 0;
  2153.     Cwd := round(  8.4800 * units);
  2154.     Angle :=   57.9946;
  2155. end;
  2156.  
  2157. with Vec^.FontInfo[ 10] do begin
  2158.     Cht := round( 13.1847 * units);
  2159.     Cdp := 0;
  2160.     Cwd := round(  9.0645 * units);
  2161.     Angle :=   55.4915;
  2162. end;
  2163.  
  2164. with Vec^.FontInfo[ 11] do begin
  2165.     Cht := round( 12.8000 * units);
  2166.     Cdp := 0;
  2167.     Cwd := round(  9.6000 * units);
  2168.     Angle :=   53.1301;
  2169. end;
  2170.  
  2171. with Vec^.FontInfo[ 12] do begin
  2172.     Cht := round( 12.4178 * units);
  2173.     Cdp := 0;
  2174.     Cwd := round( 10.0895 * units);
  2175.     Angle :=   50.9061;
  2176. end;
  2177.  
  2178. with Vec^.FontInfo[ 13] do begin
  2179.     Cht := round( 12.0412 * units);
  2180.     Cdp := 0;
  2181.     Cwd := round( 10.5361 * units);
  2182.     Angle :=   48.8141;
  2183. end;
  2184.  
  2185. with Vec^.FontInfo[ 14] do begin
  2186.     Cht := round( 11.6726 * units);
  2187.     Cdp := 0;
  2188.     Cwd := round( 10.9431 * units);
  2189.     Angle :=   46.8476;
  2190. end;
  2191.  
  2192. with Vec^.FontInfo[ 15] do begin
  2193.     Cht := round( 11.3137 * units);
  2194.     Cdp := 0;
  2195.     Cwd := round( 11.3137 * units);
  2196.     Angle :=   45.0000;
  2197. end;
  2198.  
  2199. with Vec^.FontInfo[ 16] do begin
  2200.     Cht := round( 10.9431 * units);
  2201.     Cdp := 0;
  2202.     Cwd := round( 11.6726 * units);
  2203.     Angle :=   43.1524;
  2204. end;
  2205.  
  2206. with Vec^.FontInfo[ 17] do begin
  2207.     Cht := round( 10.5361 * units);
  2208.     Cdp := 0;
  2209.     Cwd := round( 12.0412 * units);
  2210.     Angle :=   41.1859;
  2211. end;
  2212.  
  2213. with Vec^.FontInfo[ 18] do begin
  2214.     Cht := round( 10.0895 * units);
  2215.     Cdp := 0;
  2216.     Cwd := round( 12.4178 * units);
  2217.     Angle :=   39.0939;
  2218. end;
  2219.  
  2220. with Vec^.FontInfo[ 19] do begin
  2221.     Cht := round(  9.6000 * units);
  2222.     Cdp := 0;
  2223.     Cwd := round( 12.8000 * units);
  2224.     Angle :=   36.8699;
  2225. end;
  2226.  
  2227. with Vec^.FontInfo[ 20] do begin
  2228.     Cht := round(  9.0645 * units);
  2229.     Cdp := 0;
  2230.     Cwd := round( 13.1847 * units);
  2231.     Angle :=   34.5085;
  2232. end;
  2233.  
  2234. with Vec^.FontInfo[ 21] do begin
  2235.     Cht := round(  8.4800 * units);
  2236.     Cdp := 0;
  2237.     Cwd := round( 13.5680 * units);
  2238.     Angle :=   32.0054;
  2239. end;
  2240.  
  2241. with Vec^.FontInfo[ 22] do begin
  2242.     Cht := round(  7.8442 * units);
  2243.     Cdp := 0;
  2244.     Cwd := round( 13.9452 * units);
  2245.     Angle :=   29.3578;
  2246. end;
  2247.  
  2248. with Vec^.FontInfo[ 23] do begin
  2249.     Cht := round(  7.1554 * units);
  2250.     Cdp := 0;
  2251.     Cwd := round( 14.3108 * units);
  2252.     Angle :=   26.5651;
  2253. end;
  2254.  
  2255. with Vec^.FontInfo[ 24] do begin
  2256.     Cht := round(  6.4131 * units);
  2257.     Cdp := 0;
  2258.     Cwd := round( 14.6585 * units);
  2259.     Angle :=   23.6294;
  2260. end;
  2261.  
  2262. with Vec^.FontInfo[ 25] do begin
  2263.     Cht := round(  5.6180 * units);
  2264.     Cdp := 0;
  2265.     Cwd := round( 14.9813 * units);
  2266.     Angle :=   20.5560;
  2267. end;
  2268.  
  2269. with Vec^.FontInfo[ 26] do begin
  2270.     Cht := round(  4.7724 * units);
  2271.     Cdp := 0;
  2272.     Cwd := round( 15.2717 * units);
  2273.     Angle :=   17.3540;
  2274. end;
  2275.  
  2276. with Vec^.FontInfo[ 27] do begin
  2277.     Cht := round(  3.8806 * units);
  2278.     Cdp := 0;
  2279.     Cwd := round( 15.5223 * units);
  2280.     Angle :=   14.0362;
  2281. end;
  2282.  
  2283. with Vec^.FontInfo[ 28] do begin
  2284.     Cht := round(  2.9486 * units);
  2285.     Cdp := 0;
  2286.     Cwd := round( 15.7260 * units);
  2287.     Angle :=   10.6197;
  2288. end;
  2289.  
  2290. with Vec^.FontInfo[ 29] do begin
  2291.     Cht := round(  1.9846 * units);
  2292.     Cdp := 0;
  2293.     Cwd := round( 15.8764 * units);
  2294.     Angle :=    7.1250;
  2295. end;
  2296.  
  2297. with Vec^.FontInfo[ 30] do begin
  2298.     Cht := round(  0.9981 * units);
  2299.     Cdp := 0;
  2300.     Cwd := round( 15.9688 * units);
  2301.     Angle :=    3.5763;
  2302. end;
  2303.  
  2304. with Vec^.FontInfo[ 31] do begin
  2305.     Cht := 0;
  2306.     Cdp := 0;
  2307.     Cwd := round( 16.0000 * units);
  2308.     Angle :=    0.0000;
  2309. end;
  2310.  
  2311. with Vec^.FontInfo[ 32] do begin
  2312.      Cdp := round(  0.9981 * units);
  2313.      Cht := 0;
  2314.     Cwd := round( 15.9688 * units);
  2315.     Angle :=   -3.5763;
  2316. end;
  2317.  
  2318. with Vec^.FontInfo[ 33] do begin
  2319.      Cdp := round(  1.9846 * units);
  2320.      Cht := 0;
  2321.     Cwd := round( 15.8764 * units);
  2322.     Angle :=   -7.1250;
  2323. end;
  2324.  
  2325. with Vec^.FontInfo[ 34] do begin
  2326.      Cdp := round(  2.9486 * units);
  2327.      Cht := 0;
  2328.     Cwd := round( 15.7260 * units);
  2329.     Angle :=  -10.6197;
  2330. end;
  2331.  
  2332. with Vec^.FontInfo[ 35] do begin
  2333.      Cdp := round(  3.8806 * units);
  2334.      Cht := 0;
  2335.     Cwd := round( 15.5223 * units);
  2336.     Angle :=  -14.0362;
  2337. end;
  2338.  
  2339. with Vec^.FontInfo[ 36] do begin
  2340.      Cdp := round(  4.7724 * units);
  2341.      Cht := 0;
  2342.     Cwd := round( 15.2717 * units);
  2343.     Angle :=  -17.3540;
  2344. end;
  2345.  
  2346. with Vec^.FontInfo[ 37] do begin
  2347.      Cdp := round(  5.6180 * units);
  2348.      Cht := 0;
  2349.     Cwd := round( 14.9813 * units);
  2350.     Angle :=  -20.5560;
  2351. end;
  2352.  
  2353. with Vec^.FontInfo[ 38] do begin
  2354.      Cdp := round(  6.4131 * units);
  2355.      Cht := 0;
  2356.     Cwd := round( 14.6585 * units);
  2357.     Angle :=  -23.6294;
  2358. end;
  2359.  
  2360. with Vec^.FontInfo[ 39] do begin
  2361.      Cdp := round(  7.1554 * units);
  2362.      Cht := 0;
  2363.     Cwd := round( 14.3108 * units);
  2364.     Angle :=  -26.5651;
  2365. end;
  2366.  
  2367. with Vec^.FontInfo[ 40] do begin
  2368.      Cdp := round(  7.8442 * units);
  2369.      Cht := 0;
  2370.     Cwd := round( 13.9452 * units);
  2371.     Angle :=  -29.3578;
  2372. end;
  2373.  
  2374. with Vec^.FontInfo[ 41] do begin
  2375.      Cdp := round(  8.4800 * units);
  2376.      Cht := 0;
  2377.     Cwd := round( 13.5680 * units);
  2378.     Angle :=  -32.0054;
  2379. end;
  2380.  
  2381. with Vec^.FontInfo[ 42] do begin
  2382.      Cdp := round(  9.0645 * units);
  2383.      Cht := 0;
  2384.     Cwd := round( 13.1847 * units);
  2385.     Angle :=  -34.5085;
  2386. end;
  2387.  
  2388. with Vec^.FontInfo[ 43] do begin
  2389.      Cdp := round(  9.6000 * units);
  2390.      Cht := 0;
  2391.     Cwd := round( 12.8000 * units);
  2392.     Angle :=  -36.8699;
  2393. end;
  2394.  
  2395. with Vec^.FontInfo[ 44] do begin
  2396.      Cdp := round( 10.0895 * units);
  2397.      Cht := 0;
  2398.     Cwd := round( 12.4178 * units);
  2399.     Angle :=  -39.0939;
  2400. end;
  2401.  
  2402. with Vec^.FontInfo[ 45] do begin
  2403.      Cdp := round( 10.5361 * units);
  2404.      Cht := 0;
  2405.     Cwd := round( 12.0412 * units);
  2406.     Angle :=  -41.1859;
  2407. end;
  2408.  
  2409. with Vec^.FontInfo[ 46] do begin
  2410.      Cdp := round( 10.9431 * units);
  2411.      Cht := 0;
  2412.     Cwd := round( 11.6726 * units);
  2413.     Angle :=  -43.1524;
  2414. end;
  2415.  
  2416. with Vec^.FontInfo[ 47] do begin
  2417.      Cdp := round( 11.3137 * units);
  2418.      Cht := 0;
  2419.     Cwd := round( 11.3137 * units);
  2420.     Angle :=  -45.0000;
  2421. end;
  2422.  
  2423. with Vec^.FontInfo[ 48] do begin
  2424.     Cdp := round ( 11.6726 * units);
  2425.     Cht := 0;
  2426.     Cwd := round( 10.9431 * units);
  2427.     Angle :=  -46.8476;
  2428. end;
  2429.  
  2430. with Vec^.FontInfo[ 49] do begin
  2431.     Cdp := round ( 12.0412 * units);
  2432.     Cht := 0;
  2433.     Cwd := round( 10.5361 * units);
  2434.     Angle :=  -48.8141;
  2435. end;
  2436.  
  2437. with Vec^.FontInfo[ 50] do begin
  2438.     Cdp := round ( 12.4178 * units);
  2439.     Cht := 0;
  2440.     Cwd := round( 10.0895 * units);
  2441.     Angle :=  -50.9061;
  2442. end;
  2443.  
  2444. with Vec^.FontInfo[ 51] do begin
  2445.     Cdp := round ( 12.8000 * units);
  2446.     Cht := 0;
  2447.     Cwd := round(  9.6000 * units);
  2448.     Angle :=  -53.1301;
  2449. end;
  2450.  
  2451. with Vec^.FontInfo[ 52] do begin
  2452.     Cdp := round ( 13.1847 * units);
  2453.     Cht := 0;
  2454.     Cwd := round(  9.0645 * units);
  2455.     Angle :=  -55.4915;
  2456. end;
  2457.  
  2458. with Vec^.FontInfo[ 53] do begin
  2459.     Cdp := round ( 13.5680 * units);
  2460.     Cht := 0;
  2461.     Cwd := round(  8.4800 * units);
  2462.     Angle :=  -57.9946;
  2463. end;
  2464.  
  2465. with Vec^.FontInfo[ 54] do begin
  2466.     Cdp := round ( 13.9452 * units);
  2467.     Cht := 0;
  2468.     Cwd := round(  7.8442 * units);
  2469.     Angle :=  -60.6422;
  2470. end;
  2471.  
  2472. with Vec^.FontInfo[ 55] do begin
  2473.     Cdp := round ( 14.3108 * units);
  2474.     Cht := 0;
  2475.     Cwd := round(  7.1554 * units);
  2476.     Angle :=  -63.4349;
  2477. end;
  2478.  
  2479. with Vec^.FontInfo[ 56] do begin
  2480.     Cdp := round ( 14.6585 * units);
  2481.     Cht := 0;
  2482.     Cwd := round(  6.4131 * units);
  2483.     Angle :=  -66.3706;
  2484. end;
  2485.  
  2486. with Vec^.FontInfo[ 57] do begin
  2487.     Cdp := round ( 14.9813 * units);
  2488.     Cht := 0;
  2489.     Cwd := round(  5.6180 * units);
  2490.     Angle :=  -69.4440;
  2491. end;
  2492.  
  2493. with Vec^.FontInfo[ 58] do begin
  2494.     Cdp := round ( 15.2717 * units);
  2495.     Cht := 0;
  2496.     Cwd := round(  4.7724 * units);
  2497.     Angle :=  -72.6460;
  2498. end;
  2499.  
  2500. with Vec^.FontInfo[ 59] do begin
  2501.     Cdp := round ( 15.5223 * units);
  2502.     Cht := 0;
  2503.     Cwd := round(  3.8806 * units);
  2504.     Angle :=  -75.9638;
  2505. end;
  2506.  
  2507. with Vec^.FontInfo[ 60] do begin
  2508.     Cdp := round ( 15.7260 * units);
  2509.     Cht := 0;
  2510.     Cwd := round(  2.9486 * units);
  2511.     Angle :=  -79.3803;
  2512. end;
  2513.  
  2514. with Vec^.FontInfo[ 61] do begin
  2515.     Cdp := round ( 15.8764 * units);
  2516.     Cht := 0;
  2517.     Cwd := round(  1.9846 * units);
  2518.     Angle :=  -82.8750;
  2519. end;
  2520.  
  2521. with Vec^.FontInfo[ 62] do begin
  2522.     Cdp := round ( 15.9688 * units);
  2523.     Cht := 0;
  2524.     Cwd := round(  0.9981 * units);
  2525.     Angle :=  -86.4237;
  2526. end;
  2527.  
  2528. with Vec^.FontInfo[ 63] do begin
  2529.     Cht := round(  8.0000 * units);
  2530.     Cdp := 0;
  2531.     Cwd := 0;
  2532.     Angle :=   90.0000;
  2533. end;
  2534.  
  2535. with Vec^.FontInfo[ 64] do begin
  2536.     Cht := round(  7.9382 * units);
  2537.     Cdp := 0;
  2538.     Cwd := round(  0.9923 * units);
  2539.     Angle :=   82.8750;
  2540. end;
  2541.  
  2542. with Vec^.FontInfo[ 65] do begin
  2543.     Cht := round(  7.7611 * units);
  2544.     Cdp := 0;
  2545.     Cwd := round(  1.9403 * units);
  2546.     Angle :=   75.9638;
  2547. end;
  2548.  
  2549. with Vec^.FontInfo[ 66] do begin
  2550.     Cht := round(  7.4906 * units);
  2551.     Cdp := 0;
  2552.     Cwd := round(  2.8090 * units);
  2553.     Angle :=   69.4440;
  2554. end;
  2555.  
  2556. with Vec^.FontInfo[ 67] do begin
  2557.     Cht := round(  7.1554 * units);
  2558.     Cdp := 0;
  2559.     Cwd := round(  3.5777 * units);
  2560.     Angle :=   63.4349;
  2561. end;
  2562.  
  2563. with Vec^.FontInfo[ 68] do begin
  2564.     Cht := round(  6.7840 * units);
  2565.     Cdp := 0;
  2566.     Cwd := round(  4.2400 * units);
  2567.     Angle :=   57.9946;
  2568. end;
  2569.  
  2570. with Vec^.FontInfo[ 69] do begin
  2571.     Cht := round(  6.4000 * units);
  2572.     Cdp := 0;
  2573.     Cwd := round(  4.8000 * units);
  2574.     Angle :=   53.1301;
  2575. end;
  2576.  
  2577. with Vec^.FontInfo[ 70] do begin
  2578.     Cht := round(  6.0206 * units);
  2579.     Cdp := 0;
  2580.     Cwd := round(  5.2680 * units);
  2581.     Angle :=   48.8141;
  2582. end;
  2583.  
  2584. with Vec^.FontInfo[ 71] do begin
  2585.     Cht := round(  5.6569 * units);
  2586.     Cdp := 0;
  2587.     Cwd := round(  5.6569 * units);
  2588.     Angle :=   45.0000;
  2589. end;
  2590.  
  2591. with Vec^.FontInfo[ 72] do begin
  2592.     Cht := round(  5.2680 * units);
  2593.     Cdp := 0;
  2594.     Cwd := round(  6.0206 * units);
  2595.     Angle :=   41.1859;
  2596. end;
  2597.  
  2598. with Vec^.FontInfo[ 73] do begin
  2599.     Cht := round(  4.8000 * units);
  2600.     Cdp := 0;
  2601.     Cwd := round(  6.4000 * units);
  2602.     Angle :=   36.8699;
  2603. end;
  2604.  
  2605. with Vec^.FontInfo[ 74] do begin
  2606.     Cht := round(  4.2400 * units);
  2607.     Cdp := 0;
  2608.     Cwd := round(  6.7840 * units);
  2609.     Angle :=   32.0054;
  2610. end;
  2611.  
  2612. with Vec^.FontInfo[ 75] do begin
  2613.     Cht := round(  3.5777 * units);
  2614.     Cdp := 0;
  2615.     Cwd := round(  7.1554 * units);
  2616.     Angle :=   26.5651;
  2617. end;
  2618.  
  2619. with Vec^.FontInfo[ 76] do begin
  2620.     Cht := round(  2.8090 * units);
  2621.     Cdp := 0;
  2622.     Cwd := round(  7.4906 * units);
  2623.     Angle :=   20.5560;
  2624. end;
  2625.  
  2626. with Vec^.FontInfo[ 77] do begin
  2627.     Cht := round(  1.9403 * units);
  2628.     Cdp := 0;
  2629.     Cwd := round(  7.7611 * units);
  2630.     Angle :=   14.0362;
  2631. end;
  2632.  
  2633. with Vec^.FontInfo[ 78] do begin
  2634.     Cht := round(  0.9923 * units);
  2635.     Cdp := 0;
  2636.     Cwd := round(  7.9382 * units);
  2637.     Angle :=    7.1250;
  2638. end;
  2639.  
  2640. with Vec^.FontInfo[ 79] do begin
  2641.     Cht := 0;
  2642.     Cdp := 0;
  2643.     Cwd := round(  8.0000 * units);
  2644.     Angle :=    0.0000;
  2645. end;
  2646.  
  2647. with Vec^.FontInfo[ 80] do begin
  2648.      Cdp := round(  0.9923 * units);
  2649.      Cht := 0;
  2650.     Cwd := round(  7.9382 * units);
  2651.     Angle :=   -7.1250;
  2652. end;
  2653.  
  2654. with Vec^.FontInfo[ 81] do begin
  2655.      Cdp := round(  1.9403 * units);
  2656.      Cht := 0;
  2657.     Cwd := round(  7.7611 * units);
  2658.     Angle :=  -14.0362;
  2659. end;
  2660.  
  2661. with Vec^.FontInfo[ 82] do begin
  2662.      Cdp := round(  2.8090 * units);
  2663.      Cht := 0;
  2664.     Cwd := round(  7.4906 * units);
  2665.     Angle :=  -20.5560;
  2666. end;
  2667.  
  2668. with Vec^.FontInfo[ 83] do begin
  2669.      Cdp := round(  3.5777 * units);
  2670.      Cht := 0;
  2671.     Cwd := round(  7.1554 * units);
  2672.     Angle :=  -26.5651;
  2673. end;
  2674.  
  2675. with Vec^.FontInfo[ 84] do begin
  2676.      Cdp := round(  4.2400 * units);
  2677.      Cht := 0;
  2678.     Cwd := round(  6.7840 * units);
  2679.     Angle :=  -32.0054;
  2680. end;
  2681.  
  2682. with Vec^.FontInfo[ 85] do begin
  2683.      Cdp := round(  4.8000 * units);
  2684.      Cht := 0;
  2685.     Cwd := round(  6.4000 * units);
  2686.     Angle :=  -36.8699;
  2687. end;
  2688.  
  2689. with Vec^.FontInfo[ 86] do begin
  2690.      Cdp := round(  5.2680 * units);
  2691.      Cht := 0;
  2692.     Cwd := round(  6.0206 * units);
  2693.     Angle :=  -41.1859;
  2694. end;
  2695.  
  2696. with Vec^.FontInfo[ 87] do begin
  2697.      Cdp := round(  5.6569 * units);
  2698.      Cht := 0;
  2699.     Cwd := round(  5.6569 * units);
  2700.     Angle :=  -45.0000;
  2701. end;
  2702.  
  2703. with Vec^.FontInfo[ 88] do begin
  2704.     Cdp := round (  6.0206 * units);
  2705.     Cht := 0;
  2706.     Cwd := round(  5.2680 * units);
  2707.     Angle :=  -48.8141;
  2708. end;
  2709.  
  2710. with Vec^.FontInfo[ 89] do begin
  2711.     Cdp := round (  6.4000 * units);
  2712.     Cht := 0;
  2713.     Cwd := round(  4.8000 * units);
  2714.     Angle :=  -53.1301;
  2715. end;
  2716.  
  2717. with Vec^.FontInfo[ 90] do begin
  2718.     Cdp := round (  6.7840 * units);
  2719.     Cht := 0;
  2720.     Cwd := round(  4.2400 * units);
  2721.     Angle :=  -57.9946;
  2722. end;
  2723.  
  2724. with Vec^.FontInfo[ 91] do begin
  2725.     Cdp := round (  7.1554 * units);
  2726.     Cht := 0;
  2727.     Cwd := round(  3.5777 * units);
  2728.     Angle :=  -63.4349;
  2729. end;
  2730.  
  2731. with Vec^.FontInfo[ 92] do begin
  2732.     Cdp := round (  7.4906 * units);
  2733.     Cht := 0;
  2734.     Cwd := round(  2.8090 * units);
  2735.     Angle :=  -69.4440;
  2736. end;
  2737.  
  2738. with Vec^.FontInfo[ 93] do begin
  2739.     Cdp := round (  7.7611 * units);
  2740.     Cht := 0;
  2741.     Cwd := round(  1.9403 * units);
  2742.     Angle :=  -75.9638;
  2743. end;
  2744.  
  2745. with Vec^.FontInfo[ 94] do begin
  2746.     Cdp := round (  7.9382 * units);
  2747.     Cht := 0;
  2748.     Cwd := round(  0.9923 * units);
  2749.     Angle :=  -82.8750;
  2750. end;
  2751.  
  2752. with Vec^.FontInfo[ 95] do begin
  2753.     Cdp := round (  8.0000 * units);
  2754.     Cht := 0;
  2755.     Cwd := 0;
  2756.     Angle :=  -90.0000;
  2757. end;
  2758.  
  2759. with Vec^.FontInfo[ 96] do begin
  2760.     Cht := round(  4.0000 * units);
  2761.     Cdp := 0;
  2762.     Cwd := 0;
  2763.     Angle :=   90.0000;
  2764. end;
  2765.  
  2766. with Vec^.FontInfo[ 97] do begin
  2767.     Cht := round(  3.8806 * units);
  2768.     Cdp := 0;
  2769.     Cwd := round(  0.9701 * units);
  2770.     Angle :=   75.9638;
  2771. end;
  2772.  
  2773. with Vec^.FontInfo[ 98] do begin
  2774.     Cht := round(  3.5777 * units);
  2775.     Cdp := 0;
  2776.     Cwd := round(  1.7889 * units);
  2777.     Angle :=   63.4349;
  2778. end;
  2779.  
  2780. with Vec^.FontInfo[ 99] do begin
  2781.     Cht := round(  3.2000 * units);
  2782.     Cdp := 0;
  2783.     Cwd := round(  2.4000 * units);
  2784.     Angle :=   53.1301;
  2785. end;
  2786.  
  2787. with Vec^.FontInfo[100] do begin
  2788.     Cht := round(  2.8284 * units);
  2789.     Cdp := 0;
  2790.     Cwd := round(  2.8284 * units);
  2791.     Angle :=   45.0000;
  2792. end;
  2793.  
  2794. with Vec^.FontInfo[101] do begin
  2795.     Cht := round(  2.4000 * units);
  2796.     Cdp := 0;
  2797.     Cwd := round(  3.2000 * units);
  2798.     Angle :=   36.8699;
  2799. end;
  2800.  
  2801. with Vec^.FontInfo[102] do begin
  2802.     Cht := round(  1.7889 * units);
  2803.     Cdp := 0;
  2804.     Cwd := round(  3.5777 * units);
  2805.     Angle :=   26.5651;
  2806. end;
  2807.  
  2808. with Vec^.FontInfo[103] do begin
  2809.     Cht := round(  0.9701 * units);
  2810.     Cdp := 0;
  2811.     Cwd := round(  3.8806 * units);
  2812.     Angle :=   14.0362;
  2813. end;
  2814.  
  2815. with Vec^.FontInfo[104] do begin
  2816.     Cht := 0;
  2817.     Cdp := 0;
  2818.     Cwd := round(  4.0000 * units);
  2819.     Angle :=    0.0000;
  2820. end;
  2821.  
  2822. with Vec^.FontInfo[105] do begin
  2823.      Cdp := round(  0.9701 * units);
  2824.      Cht := 0;
  2825.     Cwd := round(  3.8806 * units);
  2826.     Angle :=  -14.0362;
  2827. end;
  2828.  
  2829. with Vec^.FontInfo[106] do begin
  2830.      Cdp := round(  1.7889 * units);
  2831.      Cht := 0;
  2832.     Cwd := round(  3.5777 * units);
  2833.     Angle :=  -26.5651;
  2834. end;
  2835.  
  2836. with Vec^.FontInfo[107] do begin
  2837.      Cdp := round(  2.4000 * units);
  2838.      Cht := 0;
  2839.     Cwd := round(  3.2000 * units);
  2840.     Angle :=  -36.8699;
  2841. end;
  2842.  
  2843. with Vec^.FontInfo[108] do begin
  2844.      Cdp := round(  2.8284 * units);
  2845.      Cht := 0;
  2846.     Cwd := round(  2.8284 * units);
  2847.     Angle :=  -45.0000;
  2848. end;
  2849.  
  2850. with Vec^.FontInfo[109] do begin
  2851.     Cdp := round (  3.2000 * units);
  2852.     Cht := 0;
  2853.     Cwd := round(  2.4000 * units);
  2854.     Angle :=  -53.1301;
  2855. end;
  2856.  
  2857. with Vec^.FontInfo[110] do begin
  2858.     Cdp := round (  3.5777 * units);
  2859.     Cht := 0;
  2860.     Cwd := round(  1.7889 * units);
  2861.     Angle :=  -63.4349;
  2862. end;
  2863.  
  2864. with Vec^.FontInfo[111] do begin
  2865.     Cdp := round (  3.8806 * units);
  2866.     Cht := 0;
  2867.     Cwd := round(  0.9701 * units);
  2868.     Angle :=  -75.9638;
  2869. end;
  2870.  
  2871. with Vec^.FontInfo[112] do begin
  2872.     Cdp := round (  4.0000 * units);
  2873.     Cht := 0;
  2874.     Cwd := 0;
  2875.     Angle :=  -90.0000;
  2876. end;
  2877.  
  2878. with Vec^.FontInfo[113] do begin
  2879.     Cht := round(  2.0000 * units);
  2880.     Cdp := 0;
  2881.     Cwd := 0;
  2882.     Angle :=   90.0000;
  2883. end;
  2884.  
  2885. with Vec^.FontInfo[114] do begin
  2886.     Cht := round(  1.7889 * units);
  2887.     Cdp := 0;
  2888.     Cwd := round(  0.8944 * units);
  2889.     Angle :=   63.4349;
  2890. end;
  2891.  
  2892. with Vec^.FontInfo[115] do begin
  2893.     Cht := round(  1.4142 * units);
  2894.     Cdp := 0;
  2895.     Cwd := round(  1.4142 * units);
  2896.     Angle :=   45.0000;
  2897. end;
  2898.  
  2899. with Vec^.FontInfo[116] do begin
  2900.     Cht := round(  0.8944 * units);
  2901.     Cdp := 0;
  2902.     Cwd := round(  1.7889 * units);
  2903.     Angle :=   26.5651;
  2904. end;
  2905.  
  2906. with Vec^.FontInfo[117] do begin
  2907.     Cht := 0;
  2908.     Cdp := 0;
  2909.     Cwd := round(  2.0000 * units);
  2910.     Angle :=    0.0000;
  2911. end;
  2912.  
  2913. with Vec^.FontInfo[118] do begin
  2914.      Cdp := round(  0.8944 * units);
  2915.      Cht := 0;
  2916.     Cwd := round(  1.7889 * units);
  2917.     Angle :=  -26.5651;
  2918. end;
  2919.  
  2920. with Vec^.FontInfo[119] do begin
  2921.      Cdp := round(  1.4142 * units);
  2922.      Cht := 0;
  2923.     Cwd := round(  1.4142 * units);
  2924.     Angle :=  -45.0000;
  2925. end;
  2926.  
  2927. with Vec^.FontInfo[120] do begin
  2928.     Cdp := round (  1.7889 * units);
  2929.     Cht := 0;
  2930.     Cwd := round(  0.8944 * units);
  2931.     Angle :=  -63.4349;
  2932. end;
  2933.  
  2934. with Vec^.FontInfo[121] do begin
  2935.     Cdp := round (  2.0000 * units);
  2936.     Cht := 0;
  2937.     Cwd := 0;
  2938.     Angle :=  -90.0000;
  2939. end;
  2940.  
  2941. with Vec^.FontInfo[122] do begin
  2942.     Cht := round(  1.0000 * units);
  2943.     Cdp := 0;
  2944.     Cwd := 0;
  2945.     Angle :=   90.0000;
  2946. end;
  2947.  
  2948. with Vec^.FontInfo[123] do begin
  2949.     Cht := round(  0.7071 * units);
  2950.     Cdp := 0;
  2951.     Cwd := round(  0.7071 * units);
  2952.     Angle :=   45.0000;
  2953. end;
  2954.  
  2955. with Vec^.FontInfo[124] do begin
  2956.     Cht := 0;
  2957.     Cdp := 0;
  2958.     Cwd := round(  1.0000 * units);
  2959.     Angle :=    0.0000;
  2960. end;
  2961.  
  2962. with Vec^.FontInfo[125] do begin
  2963.      Cdp := round(  0.7071 * units);
  2964.      Cht := 0;
  2965.     Cwd := round(  0.7071 * units);
  2966.     Angle :=  -45.0000;
  2967. end;
  2968.  
  2969. with Vec^.FontInfo[126] do begin
  2970.     Cdp := round (  1.0000 * units);
  2971.     Cht := 0;
  2972.     Cwd := 0;
  2973.     Angle :=  -90.0000;
  2974. end;
  2975.  
  2976. with Vec^.FontInfo[127] do begin
  2977.     Cht := 0;
  2978.     Cdp := 0;
  2979.     Cwd := 0;
  2980.     Angle :=  -90.0000;
  2981. end;
  2982.  
  2983. end; (* define vectors *)
  2984.  
  2985.  
  2986.  
  2987.  
  2988. {-------------------------------------------------}
  2989. (* If, for some reason, you do not want to deal with
  2990.   music capabilities, replace the body of this procedure
  2991.   with just a begin end; pair  and also the TylBeam proc.
  2992. *)    
  2993. procedure definebeams (* var M : pMusFontInfRec *);
  2994. var i : integer;
  2995.   begin
  2996.  
  2997. end;
  2998.  
  2999. {----------------------------------------------------------}
  3000. (* use pre-calculated coordinates of a circle that has a
  3001.  * given unit-radius. Scale those points to fit the desired radius
  3002.  *)
  3003. procedure defineCircleCpts (rad : ScaledPts; centx, centy : ScaledPts;
  3004.                 var CircleCpt : ControlPoints;
  3005.                 var numpts : integer);
  3006. const UnitRadius = 16777216; (* TWO24 scaledpts *)
  3007. var ratio : real;
  3008. begin
  3009.   if (rad = 0) then
  3010.     begin
  3011.     complain (ERRBAD);
  3012.     writeln(logfile,'Error in fig#',pgfigurenum:0,' on page ',currpagenum:0);
  3013.     writeln(logfile,'Zero length radius for circle! Setting to 1 sp');
  3014.     rad := 1;
  3015.     end;
  3016.   ratio := float(rad) / float(UnitRadius);
  3017.   numpts := 16;
  3018.   CircleCpt[1,1] := round (ratio * 16777216.00000) + centx;
  3019.   CircleCpt[1,2] := 0 + centy; {round (ratio *      0.00000)}
  3020.   CircleCpt[2,1] := round (ratio * 15500126.47492) + centx;
  3021.   CircleCpt[2,2] := round (ratio * 6420362.60441) + centy;
  3022.   CircleCpt[3,1] := round (ratio * 11863283.20303) + centx;
  3023.   CircleCpt[3,2] := round (ratio * 11863283.20303) + centy;
  3024.   CircleCpt[4,1] := round (ratio * 6420362.60441) + centx;
  3025.   CircleCpt[4,2] := round (ratio * 15500126.47492) + centy;
  3026.   CircleCpt[5,1] := 0 + centx; {round (ratio *     -0.00000) }
  3027.   CircleCpt[5,2] := round (ratio * 16777216.00000) + centy;
  3028.   CircleCpt[6,1] := round (ratio * -6420362.60441) + centx;
  3029.   CircleCpt[6,2] := round (ratio * 15500126.47492) + centy;
  3030.   CircleCpt[7,1] := round (ratio * -11863283.20303) + centx;
  3031.   CircleCpt[7,2] := round (ratio * 11863283.20303) + centy;
  3032.   CircleCpt[8,1] := round (ratio * -15500126.47492) + centx;
  3033.   CircleCpt[8,2] := round (ratio * 6420362.60441) + centy;
  3034.   CircleCpt[9,1] := round (ratio * -16777216.00000) + centx;
  3035.   CircleCpt[9,2] := 0 + centy; {round (ratio *     -0.00000)}
  3036.   CircleCpt[10,1] := round (ratio * -15500126.47492) + centx;
  3037.   CircleCpt[10,2] := round (ratio * -6420362.60441) + centy;
  3038.   CircleCpt[11,1] := round (ratio * -11863283.20303) + centx;
  3039.   CircleCpt[11,2] := round (ratio * -11863283.20303) + centy;
  3040.   CircleCpt[12,1] := round (ratio * -6420362.60441) + centx;
  3041.   CircleCpt[12,2] := round (ratio * -15500126.47492) + centy;
  3042.   CircleCpt[13,1] := 0 + centx; {round (ratio *      0.00000) }
  3043.   CircleCpt[13,2] := round (ratio * -16777216.00000) + centy;
  3044.   CircleCpt[14,1] := round (ratio * 6420362.60441) + centx;
  3045.   CircleCpt[14,2] := round (ratio * -15500126.47492) + centy;
  3046.   CircleCpt[15,1] := round (ratio * 11863283.20303) + centx;
  3047.   CircleCpt[15,2] := round (ratio * -11863283.20303) + centy;
  3048.   CircleCpt[16,1] := round (ratio * 15500126.47492) + centx;
  3049.   CircleCpt[16,2] := round (ratio * -6420362.60441) + centy;
  3050.  (*   create the pre-list phantom *)
  3051.   CircleCpt[0,1] := CircleCpt[16,1];
  3052.   CircleCpt[0,2] := CircleCpt[16,2];  
  3053. end;
  3054.  
  3055.  
  3056. {---------------------------------------------------------------}
  3057. (* compute control points for an arc going from startangle to 
  3058.  * stopangle, centered at (centx, centy)
  3059.  *)
  3060. procedure definearcpts (rad : ScaledPts; centx, centy : ScaledPts;
  3061.             startang, stopang : integer;
  3062.             var cpts : ControlPoints;
  3063.             var nknots : integer);
  3064. var n : integer;
  3065.     a, b, curr, delta: real;
  3066.     i : integer;
  3067. begin
  3068.   a := startang * DEGTORAD;
  3069.   b := stopang * DEGTORAD;
  3070.   n := 16;
  3071.  
  3072.   if (a > b) then
  3073.    begin
  3074.     a := a - (2 * PI);
  3075.    end;
  3076.  
  3077.   delta := abs(b - a) / n;
  3078.  
  3079.   if (a = b) then
  3080.    begin
  3081.    complain (ERRNOTBAD);
  3082.    writeln(logfile,'Error in compute arc points:: should be a circle');
  3083.    end;
  3084.  curr := a;
  3085.  i := 1;
  3086.  while ((curr <= b)) do
  3087.    begin     (* make arc about (centx,centy) *)
  3088.    cpts[i,1] := round (rad * cos (curr)) + centx;
  3089.    cpts[i,2] := round (rad * sin (curr)) + centy;
  3090.    i := i + 1;
  3091.    curr := curr + delta;
  3092.    end;  (* while *)
  3093.  
  3094. (* go one point beyond --
  3095.  *  around the arc so that we can have good smoothness
  3096.  *  for this phantom point 
  3097.  *)
  3098.  
  3099.  cpts[i,1] := round (rad * cos (b + delta)) + centx;
  3100.  cpts[i,2] := round (rad * sin (b + delta)) + centy;
  3101.  
  3102. (* and one phantom point before the list *)
  3103.  cpts[0,1] := round (rad * cos (a - delta)) + centx;
  3104.  cpts[0,2] := round (rad * sin (a - delta)) + centy;
  3105.  
  3106.  
  3107.  nknots := i-1;
  3108. end; 
  3109.               
  3110.   
  3111.  
  3112. (* &&Module spline.p *)
  3113. (*
  3114.  Procedures below may make free use of the global variables
  3115.         arrayXY   [list of control points]
  3116.         pointmatrix [list of spline segments]
  3117.         knot    [list of spline knots]
  3118.         catrommtx  [matrix for Catmull-Rom splines]
  3119.         bsplmtx   [matrix for B-splines]
  3120.         lastPoint, intervals
  3121. *)
  3122.  
  3123.  
  3124. {-----------------------------------------------------}
  3125. function max (a, b: integer):integer;
  3126. begin
  3127.   if (a > b) then
  3128.     max := a
  3129.   else
  3130.     max := b;
  3131. end;
  3132.  
  3133. {-----------------------------------------------------}
  3134. function min (a, b: integer):integer;
  3135. begin
  3136.   if (a < b) then
  3137.     min := a
  3138.   else
  3139.     min := b;
  3140. end;
  3141.  
  3142. {---------------------------------------------------------------------}
  3143. (* initialize the Catmull-Rom basis matrix *)
  3144.  
  3145. procedure initcrmatrix;
  3146. begin
  3147.   catrommtx[1,1] := -0.5; catrommtx[1,2] := 1.5;
  3148.   catrommtx[1,3] := -1.5; catrommtx[1,4] := 0.5;
  3149.   catrommtx[2,1] := 1.0;  catrommtx[2,2] := -2.5;
  3150.   catrommtx[2,3] := 2.0;  catrommtx[2,4] := -0.5;
  3151.   catrommtx[3,1] := -0.5; catrommtx[3,2] := 0.0;
  3152.   catrommtx[3,3] := 0.5;  catrommtx[3,4] := 0.0;
  3153.   catrommtx[4,1] := 0.0;  catrommtx[4,2] := 1.0;
  3154.   catrommtx[4,3] := 0.0;  catrommtx[4,4] := 0.0;
  3155. end;
  3156.  
  3157. {-----------------------------------------------------}
  3158. procedure initbsplmatrix;
  3159. begin
  3160.   bsplmtx[1,1] := -1.0/6.0;     bsplmtx[1,2] := 0.5;
  3161.   bsplmtx[1,3] := -0.5;         bsplmtx[1,4] := 1.0/6.0;
  3162.   bsplmtx[2,1] := 0.5;          bsplmtx[2,2] := -1.0;
  3163.   bsplmtx[2,3] := 0.5;          bsplmtx[2,4] := 0.0;
  3164.   bsplmtx[3,1] := -0.5;         bsplmtx[3,2] := 0.0;
  3165.   bsplmtx[3,3] := 0.5;          bsplmtx[3,4] := 0.0;
  3166.   bsplmtx[4,1] := 1.0/6.0;      bsplmtx[4,2] := 2.0/3.0;
  3167.   bsplmtx[4,3] := 1.0/6.0;      bsplmtx[4,4] := 0.0;
  3168. end;
  3169.  
  3170. {--------------------------------------------------------}    
  3171. (* init the Cardinal Spline Matrix *)
  3172. procedure initcardmatrix;
  3173. begin
  3174.   cardmtx[1,1] := -1.0; cardmtx[1,2] := 1.0;
  3175.   cardmtx[1,3] := -1.0; cardmtx[1,4] := 1.0;
  3176.   cardmtx[2,1] := 2.0;  cardmtx[2,2] := -2.0;
  3177.   cardmtx[2,3] := 1.0;  cardmtx[2,4] := -1.0;
  3178.   cardmtx[3,1] := -1.0; cardmtx[3,2] := 0.0;
  3179.   cardmtx[3,3] := 1.0;  cardmtx[3,4] := 0.0;
  3180.   cardmtx[4,1] := 0.0;  cardmtx[4,2] := 1.0;
  3181.   cardmtx[4,3] := 0.0;  cardmtx[4,4] := 0.0;
  3182. end;
  3183.  
  3184. {--------------------------------------------------------}    
  3185. procedure initallspline;
  3186.   begin
  3187.   initcrmatrix;
  3188.   initbsplmatrix;
  3189.   initcardmatrix;
  3190.   end;
  3191.  
  3192.  
  3193. {-----------------------------------------------------}
  3194. procedure matXvector (var m: Fourby4Matrix; (* IN *)
  3195.             var v: Oneby4Vector; (* IN *)
  3196.                         var result: Oneby4Vector); (* OUT *)
  3197. var t: Oneby4Vector;
  3198. begin
  3199.   t[1] := v[1]*m[1,1] + v[2]*m[1,2] + v[3]*m[1,3] + v[4]*m[1,4];
  3200.   t[2] := v[1]*m[2,1] + v[2]*m[2,2] + v[3]*m[2,3] + v[4]*m[2,4];
  3201.   t[3] := v[1]*m[3,1] + v[2]*m[3,2] + v[3]*m[3,3] + v[4]*m[3,4];
  3202.   t[4] := v[1]*m[4,1] + v[2]*m[4,2] + v[3]*m[4,3] + v[4]*m[4,4];
  3203.   result[1] := t[1]; result[2] := t[2];
  3204.   result[3] := t[3]; result[4] := t[4];
  3205. end;
  3206.  
  3207. {-----------------------------------------------------}
  3208. (* actually the dot-product *)
  3209. function vecXvec (var v1, v2: Oneby4Vector) : real;
  3210. begin
  3211.   vecXvec := v1[1]*v2[1] + v1[2]*v2[2] + v1[3]*v2[3] + v1[4]*v2[4];
  3212. end;
  3213.  
  3214.  
  3215. {------------------------------------------------------}
  3216. (* basXctl is the pre-computed BasisMatrix times the control-point vector *)
  3217.  
  3218. function splinePosition (var basXctl : Oneby4Vector; (* IN *)
  3219.             t : real ) : real;
  3220. var tvect : Oneby4Vector;    { vector of t values for spline matrix}
  3221. begin
  3222.   tvect[4] := 1.0;
  3223.   tvect[3] := t;
  3224.   tvect[2] := t * t;
  3225.   if (tvect[2] <= MINREAL) then
  3226.     begin            (* avoid underflow problems *)
  3227.     tvect[2] := 0.0;
  3228.     end;
  3229.   tvect[1] := t * tvect[2];  (* t^3 *)
  3230.   splinePosition := vecXvec (tvect, basXctl);  
  3231. end;  
  3232.             
  3233. {-------------------------------------------------}
  3234. function TwoToThe (n : integer) : integer;
  3235. label 78;
  3236. var i : integer;
  3237.     tmp : integer;
  3238. begin
  3239. tmp := 1;
  3240. if (n <= 0) then
  3241.   goto 78;
  3242. if (n < 6) then
  3243.   begin
  3244.     case n of
  3245.       1 : tmp := 2;
  3246.       2 : tmp := 4;
  3247.       3 : tmp := 8;
  3248.       4 : tmp := 16;
  3249.       5 : tmp := 32;
  3250.     end; (* case *)
  3251.   end  (* if *)
  3252. else
  3253.   begin
  3254.   tmp := 32;
  3255.   for i := 6 to n do
  3256.    tmp := tmp * 2;
  3257.   end;
  3258. 78:
  3259.   TwoToThe := tmp;
  3260. end;  
  3261.  
  3262. {------------------------------------------------------}
  3263. function distance (x0, y0, x1, y1 : real) : real;
  3264. var res : real;
  3265. begin
  3266.   res := sqrt ( (x1 - x0)*(x1 - x0) + (y1 - y0)*(y1 - y0));
  3267.   distance := res;
  3268. end;  
  3269.  
  3270.  
  3271. {------------------------------------------------------}
  3272. (* compute the number of subdivisions for this span.
  3273.    We do this by a quadrature method and a simple linear-distance
  3274.    metric. This is not optimal in the number of subdivisions actually
  3275.    required, but is computationally efficient and accurate to the 
  3276.    nearest power of 2 .
  3277.    *)
  3278. function numsubdivisions (var XtimesBas, YtimesBas : Oneby4Vector;
  3279.               resolution : ScaledPts): integer;
  3280. var n : integer;
  3281.     d : integer;  
  3282.     t : real;
  3283.     x0, y0, xt, yt : real;
  3284. begin
  3285.   x0 := splinePosition (XtimesBas, 0.0);
  3286.   y0 := splinePosition (YtimesBas, 0.0);
  3287.  
  3288.   t := 1.0;
  3289.   n := 0;
  3290.   xt := splinePosition (XtimesBas, t);
  3291.   yt := splinePosition (YtimesBas, t);  
  3292.  
  3293.   while ((round (distance (x0, y0, xt, yt)) > resolution) or
  3294.        (n < 1)) do
  3295.     begin
  3296.     t := t / 2.0; (* perform the quadrature *)
  3297.     n := n + 1;
  3298.     xt := splinePosition (XtimesBas, t);
  3299.     yt := splinePosition (YtimesBas, t);  
  3300.     end;  (* while *)
  3301.   numsubdivisions := TwoToThe (n);  
  3302. end;  
  3303.  
  3304. {------------------------------------------------------------------------}
  3305. (*  compute new control vertices such that the resulting spline
  3306.  * will interpolate through the old control points.
  3307.  * This will work as long as the actual arc length
  3308.  * between consecutive nodes does not vary from span to span.
  3309.  * The method is noted in Wu and Abel's CACM 20(10) Oct 77 paper 
  3310.  * but the actual working method is from
  3311.  *    Barsky and Greenberg's paper in
  3312.  *    CG&IP 14(3) Nov 1980 pp.203-226
  3313.  *)
  3314. procedure invertsplvertices (numpts : integer; 
  3315.                 isclosed : boolean;
  3316.                 var xys : ControlPoints); (* INOUT *)
  3317. var i : integer;
  3318.     beta, Xrprime, Yrprime : array[0..MAXCTLPTS] of real;
  3319.     tempxys : ControlPoints;
  3320. begin
  3321.     (* compute the values of beta *)
  3322.   beta[1] := 0.25;
  3323.   for i := 2 to numpts + 1 do
  3324.     beta[i] := 1.0 / (4.0 - beta[i - 1]);
  3325.  
  3326.     (* and the r primes from the original vertices *)
  3327.   Xrprime[1] := beta[1] * xys[1,1] * 5.0;
  3328.   Yrprime[1] := beta[1] * xys[1,2] * 5.0;
  3329.   for i := 2 to numpts -1 do
  3330.     begin
  3331.     Xrprime[i] := beta[i] * (6.0 * xys[i,1] - Xrprime[i - 1]);
  3332.     Yrprime[i] := beta[i] * (6.0 * xys[i,2] - Yrprime[i - 1]);
  3333.     end;  (* for *)
  3334.   Xrprime[numpts] := beta[numpts] * (5.0 * xys[numpts,1] - Xrprime[numpts - 1]);
  3335.   Yrprime[numpts] := beta[numpts] * (5.0 * xys[numpts,2] - Yrprime[numpts - 1]);
  3336.  
  3337. (* Now perform the back-substitution from the bottom up *)
  3338.   tempxys[numpts,1] := round (Xrprime[numpts]);
  3339.   tempxys[numpts,2] := round (Yrprime[numpts]);
  3340.   for i := numpts - 1 downto 1 do
  3341.     begin
  3342.     tempxys[i,1] := round (Xrprime[i] - beta[i] * tempxys[i + 1, 1]);
  3343.     tempxys[i,2] := round (Yrprime[i] - beta[i] * tempxys[i + 1, 2]);
  3344.     end;
  3345.  
  3346. if (isclosed) then
  3347.   begin
  3348.  (* at this point, we've probably been through one control-point
  3349.   *  adjustment, so let's not muck it up 
  3350.   *)
  3351.   tempxys[numpts+1,1] := tempxys[1,1];
  3352.   tempxys[numpts+1,2] := tempxys[1,2];
  3353.   tempxys[numpts+2,1] := tempxys[2,1];
  3354.   tempxys[numpts+2,2] := tempxys[2,2];
  3355.   tempxys[0,1] := tempxys[numpts,1];
  3356.   tempxys[0,2] := tempxys[numpts,2];
  3357.       (* copy them back *)
  3358.   for i := 0 to (numpts+2) do
  3359.     begin
  3360.     xys[i,1] := tempxys[i,1];
  3361.     xys[i,2] := tempxys[i,2];
  3362.     end;  
  3363.   end  (* closed *)
  3364. else
  3365.   begin
  3366.   (* copy back *)
  3367.   for i := 2 to numpts -1 do
  3368.    begin
  3369.     xys[i,1] := tempxys[i,1];
  3370.     xys[i,2] := tempxys[i,2];
  3371.    end;
  3372.   end;  (* open*)
  3373. end; 
  3374.                   
  3375.  
  3376. {-----------------------------------------------------}
  3377. (*  adjust the list of control points so that we can use
  3378.  *   it for  B-spline interpolation.  
  3379.  *  Add any "phantom" vertices necessary so that the end
  3380.  *   conditions will be correct for interpolation
  3381.  *)
  3382. procedure Bctlptadjust (isclosed : boolean; isarc : boolean;
  3383.              var n: integer; (* INOUT *)
  3384.                          var xys: ControlPoints; (* INOUT *)
  3385.                          var thx: ThickAryType); (* INOUT *)
  3386. var j : integer;
  3387.     tmp : ControlPoints;
  3388.     tmpthx : ThickAryType;
  3389. begin   (* ctlpt adjust*)
  3390.  
  3391. if (isclosed) then
  3392.   begin
  3393. (* here, we have to supply the last 'real' point for the user,
  3394.    and add three phantoms-- one before, and two after *)
  3395.  
  3396.   if (n = 2) then
  3397.     begin
  3398.     complain (ERRBAD);
  3399.     writeln(logfile,'A closed spline requires more than 2 control points ');
  3400.     writeln(logfile,'making a temporary fix in order to continue...');
  3401.     xys[3,1] := xys[1,1];
  3402.     xys[3,2] := xys[1,2];
  3403.     end;  
  3404.  
  3405.   for j := 1 to (n) do
  3406.     begin
  3407.     tmp[j, 1] := xys[j, 1];
  3408.     tmp[j, 2] := xys[j, 2];
  3409.     tmpthx[j] := thx[j];
  3410.     end;
  3411.         (* Now take care of the 'phantom' vertices *)    
  3412.   tmp[n+1, 1] := xys[1, 1];
  3413.   tmp[n+1, 2] := xys[1, 2];
  3414.   tmpthx[n+1] := thx[1];
  3415.   tmp[n+2, 1] := xys[2, 1];
  3416.   tmp[n+2, 2] := xys[2, 2];
  3417.   tmpthx[n+2] := thx[2];
  3418.   tmp[n+3, 1] := xys[3, 1]; 
  3419.   tmp[n+3, 2] := xys[3, 2];
  3420.   tmpthx[n+3] := thx[3];
  3421.  
  3422.   if (not isarc) then
  3423.     begin
  3424.     tmp[0,1] := xys[n, 1]; (* wrap around to the real last point *)
  3425.     tmp[0,2] := xys[n, 2];
  3426.     tmpthx[0] := thx[n];
  3427.     end
  3428.   else
  3429.     begin
  3430.     tmp[0,1] := xys[0,1];
  3431.     tmp[0,2] := xys[0,2];
  3432.     tmpthx[0] := thx[0];
  3433.     end;
  3434.  
  3435.   n := n + 1;     (* we supplied the 'last' point for the user *)
  3436.  
  3437.   for j := 0 to n+2 do
  3438.     begin
  3439.     xys[j,1] := tmp[j,1];
  3440.     xys[j,2] := tmp[j,2];
  3441.     thx[j] := tmpthx[j];
  3442.     end;  (* for *)
  3443.   end  (* if closed *)
  3444. else 
  3445.   begin         (* OPEN SPLINE *)
  3446.   if (not isarc) then
  3447.     begin
  3448.     tmp[0,1] := 2 * xys[1, 1] - xys[2,1];
  3449.     tmp[0,2] := 2 * xys[1, 2] - xys[2,2];
  3450.     end
  3451.   else
  3452.     begin
  3453.     tmp[0,1] := xys[0,1];
  3454.     tmp[0,2] := xys[0,2];
  3455.     end;
  3456.   tmpthx[0] := thx[1];
  3457.  
  3458.   for j := 1 to (n) do
  3459.     begin
  3460.     tmp[j, 1] := xys[j, 1];
  3461.     tmp[j, 2] := xys[j, 2];
  3462.     tmpthx[j] := thx[j];
  3463.     end;
  3464.   
  3465.   tmp[n+1, 1] := 2 * xys[n, 1] - xys[n-1,1];
  3466.   tmp[n+1, 2] := 2 * xys[n, 2] - xys[n-1,2];
  3467.   tmpthx[n+1] := thx[n];
  3468.  
  3469.   tmp[n+2, 1] := tmp[n+1, 1];
  3470.   tmp[n+2, 2] := tmp[n+1, 2];
  3471.   tmpthx[n+2] := thx[n];
  3472.  
  3473.   for j := 0 to n+2 do
  3474.     begin
  3475.     xys[j,1] := tmp[j,1];
  3476.     xys[j,2] := tmp[j,2];
  3477.     thx[j] := tmpthx[j];
  3478.     end;  (* for *)
  3479.   end; (*  if open *)
  3480.   
  3481. end;
  3482.  
  3483.  
  3484.  
  3485. {-----------------------------------------------------}
  3486. (*  adjust the list of control points so that we can use
  3487.  *       it for simple Catmull-Rom spline interpolation.  
  3488.  *  Add any "phantom" vertices necessary so that the end
  3489.  *   conditions will be correct for interpolation
  3490.  *)
  3491. procedure CRctlptadjust (isclosed : boolean; isarc : boolean;
  3492.              var n: integer; (* INOUT *)
  3493.                          var xys: ControlPoints; (* INOUT *)
  3494.                          var thx: ThickAryType); (* INOUT *)
  3495. var j : integer;
  3496.     tmp : ControlPoints;
  3497.     tmpthx : ThickAryType;
  3498. begin   (* ctlpt adjust*)
  3499. if (isclosed) then
  3500.   begin
  3501. (* here, we have to supply the last 'real' point for the user,
  3502.    and add three phantoms-- one before, and two after *)
  3503.  
  3504.   if (n = 2) then
  3505.     begin
  3506.       complain (ERRBAD);
  3507.       writeln(logfile,'A closed spline requires more than 2 control points ');
  3508.       writeln(logfile,'making a temporary fix in order to continue...');
  3509.       xys[3,1] := xys[1,1];
  3510.       xys[3,2] := xys[1,2];
  3511.     end;  
  3512.  
  3513.  
  3514.   for j := 1 to (n) do
  3515.     begin
  3516.     tmp[j, 1] := xys[j, 1];
  3517.     tmp[j, 2] := xys[j, 2];
  3518.     tmpthx[j] := thx[j];
  3519.     end;
  3520.             (* the phantom vertices *)    
  3521.     tmp[n+1, 1] := xys[1, 1];
  3522.     tmp[n+1, 2] := xys[1, 2];
  3523.     tmpthx[n+1] := thx[1];
  3524.     tmp[n+2, 1] := xys[2, 1];
  3525.     tmp[n+2, 2] := xys[2, 2];
  3526.     tmpthx[n+2] := thx[2];
  3527.     tmp[n+3, 1] := xys[3, 1];
  3528.     tmp[n+3, 2] := xys[3, 2];
  3529.     tmpthx[n+3] := thx[3];
  3530.   
  3531.     if (not isarc) then
  3532.       begin
  3533.       tmp[0,1] := xys[n, 1]; (* wrap around to the real last point *)
  3534.       tmp[0,2] := xys[n, 2];
  3535.       tmpthx[0] := thx[n];
  3536.       end
  3537.     else
  3538.       begin
  3539.       tmp[0,1] := xys[0,1];
  3540.       tmp[0,2] := xys[0,2];
  3541.       tmpthx[0] := thx[0];
  3542.       end;
  3543.     n := n + 1; (* we supplied the 'last' point for the user *)
  3544.   
  3545.     for j := 0 to n+2 do
  3546.       begin
  3547.       xys[j,1] := tmp[j,1];
  3548.       xys[j,2] := tmp[j,2];
  3549.       thx[j] := tmpthx[j];
  3550.       end;  (* for *)
  3551.   end  (* if closed *)
  3552. else
  3553.   begin (* OPEN SPLINE *)
  3554.   if (not isarc) then
  3555.     begin
  3556.     tmp[0,1] := xys[1, 1]; (* double the first point *)
  3557.     tmp[0,2] := xys[1, 2];
  3558.     end
  3559.   else
  3560.     begin
  3561.     tmp[0,1] := xys[0,1];
  3562.     tmp[0,2] := xys[0,2];
  3563.     end;  
  3564.   tmpthx[0] := thx[1];
  3565.  
  3566.   for j := 1 to (n) do
  3567.     begin
  3568.     tmp[j, 1] := xys[j, 1];
  3569.     tmp[j, 2] := xys[j, 2];
  3570.     tmpthx[j] := thx[j];
  3571.     end;
  3572.     
  3573.   tmp[n+1, 1] := xys[n, 1]; (* and triple the last *)
  3574.   tmp[n+1, 2] := xys[n, 2];
  3575.   tmpthx[n+1] := thx[n];
  3576.   tmp[n+2, 1] := xys[n, 1];
  3577.   tmp[n+2, 2] := xys[n, 2];
  3578.   tmpthx[n+2] := thx[n];
  3579.  
  3580.   for j := 0 to n+2 do
  3581.     begin
  3582.     xys[j,1] := tmp[j,1];
  3583.     xys[j,2] := tmp[j,2];
  3584.     thx[j] := tmpthx[j];
  3585.     end;  (* for *)
  3586.   end; (* if open *)
  3587. end;    (* ctlpt adjust *)
  3588.  
  3589.      
  3590.  
  3591. {----------------------------------------------------------}
  3592.  
  3593. procedure interpsplines (splinetype: SplineKind;
  3594.              isclosed: boolean;
  3595.              isanArc: boolean;
  3596.              linepatt : LineStyle;
  3597.                          var basismatrix : Fourby4Matrix; (* IN *)
  3598.                          numctls: integer; 
  3599.                          var arrayXY: ControlPoints; (* IN *)
  3600.                          var pointmatrix: SplineSegments; (* OUT *)
  3601.                          varythicks: boolean;
  3602.                          var thickmatrix: ThickAryType; (* IN *)
  3603.                          var TTmatrix: ThickAryType); (* OUT *)
  3604. label 32;
  3605. var xctl, yctl,        { vectors of x, y posits of control points}
  3606.     wctl : Oneby4Vector; {vector of thicknesses at each ctl pt}
  3607.     t, incr: real;
  3608.     Pi: integer;    { P sub i }
  3609.     i, currpt : integer;    
  3610.     theresolution : ScaledPts;
  3611.  
  3612. begin (* interp splines*)
  3613.   if ((not isclosed) and (isanArc)) then
  3614.     numctls := numctls + 1; (* lie a little *)
  3615.  
  3616.    case (splinetype) of
  3617.  
  3618.      BSPL: Bctlptadjust (isclosed, isanArc, numctls, arrayXY, thickmatrix);
  3619.      
  3620.      CARD,
  3621.      CATROM:  CRctlptadjust (isclosed, isanArc, numctls, arrayXY, thickmatrix);
  3622.     
  3623.      INTBSPL: begin
  3624.              if (isclosed) then
  3625.           begin
  3626.           Bctlptadjust (true, isanArc, numctls, arrayXY, thickmatrix);
  3627.           invertsplvertices (numctls, true, arrayXY);
  3628.           end
  3629.         else 
  3630.           begin
  3631.           invertsplvertices (numctls, false, arrayXY);
  3632.           Bctlptadjust (false, isanArc, numctls, arrayXY, thickmatrix);
  3633.           end;  (* else *)
  3634.                end; (* Interpolating Bsplines *)
  3635.    end;
  3636.  
  3637.   if ((not isclosed) and (isanArc)) then
  3638.     numctls := numctls - 1; (* UN-lie a little *)
  3639.  
  3640.  
  3641. (* this is the scheme:
  3642.  *    val :=  t-vector   *  Basis matrix     * point matrix
  3643.  *        [t^3  t^2 t 1] *      [[Ms]]       * [Pi-1 Pi Pi+1 Pi+2]
  3644.  *    where "Pi-1" is "P sub (i-1)", etc.
  3645.  *
  3646.  *  But we do this in a round about way:
  3647.  *        Point matrix * basis
  3648.  *   then   * t-vector   will yield the single value
  3649.  *   
  3650.  *   there are certainly faster ways to do this, 
  3651.  *   but this is the easiest to understand
  3652.  *)
  3653.  
  3654.   currpt := 1;
  3655.   case linepatt of
  3656.      solid : theresolution := MAXVECLENsp;
  3657.      dotted,
  3658.      dashed,
  3659.      dotdash : theresolution := 3 * MAXVECLENsp; {###}
  3660.    end;
  3661.  
  3662.   for Pi := 1 to (numctls - 1) do
  3663.     begin
  3664.     xctl[1] := float(arrayXY[Pi-1, 1]);
  3665.     xctl[2] := float(arrayXY[Pi,   1]);
  3666.     xctl[3] := float(arrayXY[Pi+1, 1]);
  3667.     xctl[4] := float(arrayXY[Pi+2, 1]);
  3668.     yctl[1] := float(arrayXY[Pi-1, 2]);
  3669.     yctl[2] := float(arrayXY[Pi,   2]);
  3670.     yctl[3] := float(arrayXY[Pi+1, 2]);
  3671.     yctl[4] := float(arrayXY[Pi+2, 2]);
  3672.     matXvector (basismatrix, xctl, xctl);
  3673.     matXvector (basismatrix, yctl, yctl);
  3674.  
  3675.     (* compute the delta-t increment for this segment
  3676.         based on a metric for subdivision *)
  3677.     intervals := numsubdivisions (xctl, yctl, theresolution);
  3678.     if ((linepatt = solid) and (intervals <= 2)) then
  3679.       intervals := intervals * 2;
  3680.     incr := 1.0 / intervals;
  3681.  
  3682.     (* avoid over-flowing the "pointmatrix" *)
  3683.     if ((currpt + intervals - 1) >= MAXSPLINESEGS) then
  3684.        begin
  3685.        complain (ERRREALBAD);
  3686.        writeln (logfile,'error: Too many spline segments required.');
  3687.        writeln (logfile,' Reducing the number of control points to get output.');
  3688.        goto 32;
  3689.        end;
  3690.   
  3691.     t := 0.0;
  3692.     while (t < 0.999999999) do
  3693.       begin
  3694.     pointmatrix[currpt, 1] := round (splinePosition (xctl, t));
  3695.     pointmatrix[currpt, 2] := round (splinePosition (yctl, t));
  3696.  
  3697.     if (varythicks) then
  3698.       begin
  3699.         wctl[1] := float(thickmatrix[Pi-1]);
  3700.         wctl[2] := float(thickmatrix[Pi  ]);
  3701.         wctl[3] := float(thickmatrix[Pi+1]);
  3702.         wctl[4] := float(thickmatrix[Pi+2]);
  3703.         matXvector (catrommtx, wctl, wctl);  (* requires using Catmull-Rom *)
  3704.         TTmatrix[currpt] := round (splinePosition (wctl, t));
  3705.       end;
  3706.     
  3707.         t := t + incr;
  3708.         currpt := currpt + 1;
  3709.       end; (* while loop *)
  3710.  
  3711.  
  3712.     end; (* for loop *)
  3713.  
  3714. 32:
  3715.     (* the END-condtion *)
  3716.     pointmatrix[currpt, 1] := round (splinePosition (xctl, 1.0));
  3717.     pointmatrix[currpt, 2] := round (splinePosition (yctl, 1.0));    
  3718.     if (varythicks) then
  3719.       begin
  3720.     wctl[1] := thickmatrix[numctls-2];
  3721.     wctl[2] := thickmatrix[numctls-1];
  3722.     wctl[3] := thickmatrix[numctls];
  3723.     wctl[4] := thickmatrix[numctls+1];
  3724.     matXvector (catrommtx, wctl, wctl);  (* requires using Catmull-Rom *)
  3725.     TTmatrix[currpt] := round (splinePosition (wctl, 1.0));
  3726.       end;
  3727.  
  3728.     lastPoint := currpt;
  3729.  
  3730. end; (* interpsplines *)
  3731.  
  3732.  
  3733. {----------------------------------------------------------------}
  3734. procedure drawSpline (splinetype : SplineKind;
  3735.              isclosed: boolean;
  3736.              isanArc: boolean;
  3737.              patt : LineStyle;
  3738.                      numctls: integer;
  3739.                      var arrayXY: ControlPoints; (* IN *)
  3740.                      var pointmatrix: SplineSegments; (* OUT *)
  3741.                      varythicks: boolean;
  3742.                      var thickmatrix: ThickAryType; (* IN *)
  3743.                      var TTmatrix: ThickAryType); (* OUT *)
  3744. begin
  3745.   lastPoint := 0;
  3746.  
  3747.  
  3748.   case (splinetype) of
  3749.     CATROM : interpsplines (splinetype, isclosed, isanArc, patt, catrommtx,
  3750.                numctls, arrayXY, pointmatrix,
  3751.                          varythicks, thickmatrix, TTmatrix);
  3752.  
  3753.     CARD : interpsplines (splinetype, isclosed, isanArc, patt, cardmtx, 
  3754.                numctls, arrayXY, pointmatrix, 
  3755.                        varythicks, thickmatrix, TTmatrix);
  3756.  
  3757.     BSPL : interpsplines (splinetype, isclosed, isanArc, patt, bsplmtx, 
  3758.                numctls, arrayXY, pointmatrix, 
  3759.                        varythicks, thickmatrix, TTmatrix);
  3760.  
  3761.     INTBSPL : interpsplines (splinetype, isclosed, isanArc, patt, bsplmtx,
  3762.                numctls, arrayXY, pointmatrix, 
  3763.                        varythicks, thickmatrix, TTmatrix);
  3764.   end; (*Case *)                   
  3765. end;
  3766.  
  3767.  
  3768. (* &&module TeXtyl *)
  3769. {----------------------------------------------------------------}
  3770. (* rotate a (x,y) point about mx, my *)
  3771. procedure ptrotate (var x, y : integer;
  3772.                         mx, my: integer;
  3773.                         angle : real);
  3774. var tmpx, tmpy : integer;
  3775.     cosa, sina : real;
  3776. begin
  3777.   tmpx := x - mx;       
  3778.   tmpy := y - my;
  3779.   cosa := cos(angle * DEGTORAD); 
  3780.   sina := sin(angle * DEGTORAD);
  3781.   x := round(tmpx * cosa - tmpy * sina) + mx;
  3782.   y := round(tmpx * sina + tmpy * cosa) + my;
  3783. end;
  3784.  
  3785. {----------------------------------------------------------------}
  3786. (* transform two line points: scale, rotate and translate 
  3787. *)
  3788. procedure xfmlinepts (var x1, y1, x2, y2 : ScaledPts;
  3789.                         offh, offv : ScaledPts;
  3790.                         midx, midy : ScaledPts;
  3791.                         scalefact : real;
  3792.                         theta : real;
  3793.                         dx, dy : ScaledPts;
  3794.                         sx, sy : real);
  3795. begin
  3796.   if ((sx = 0.0) or (sy = 0.0)) then
  3797.     begin
  3798.       complain (ERRBAD);
  3799.       writeln(logfile,'?? Some scale factor is Zero... continuing anyway');
  3800.     end;
  3801.         (* scale about center of item*)
  3802.   if ((sx <> 1.0) or (sy <> 1.0)) then
  3803.    begin
  3804.    x1 := round((x1 - midx) * sx) + midx;
  3805.    x2 := round((x2 - midx) * sx) + midx;
  3806.    y1 := round((y1 - midy) * sy) + midy;     
  3807.    y2 := round((y2 - midy) * sy) + midy;
  3808.    end;
  3809.       (* rotate if necessary *)
  3810.    if (theta <> 0.0) then
  3811.      begin  (* rotate about the midpoint *)
  3812.      ptrotate(x1, y1, midx, midy, theta);
  3813.      ptrotate(x2, y2, midx, midy, theta);
  3814.      end;
  3815.       (* translate *)
  3816.    x1 := (x1 + round(dx * scalefact) + offh);
  3817.    x2 := (x2 + round(dx * scalefact) + offh);
  3818.    y1 := (y1 + round(dy * scalefact) + offv);
  3819.    y2 := (y2 + round(dy * scalefact) + offv);
  3820. end;  (* xfmlinepts *)
  3821.  
  3822. {----------------------------------------------------------------}
  3823. procedure xfmcontpts (var xpts : ControlPoints; xknots : integer;
  3824.                         offh, offv : ScaledPts; midx, midy : ScaledPts;
  3825.                         scalefact : real;
  3826.                         theta : real; dx, dy : ScaledPts; sx, sy : real);
  3827. var i : integer;
  3828. begin
  3829.     (* scale about center of item *)
  3830.  if ((sx <> 1.0) or (sy <> 1.0)) then
  3831.   for i := 0 to xknots do
  3832.      begin
  3833.      xpts[i,1] := round((xpts[i,1] - midx) * sx) + midx;
  3834.      xpts[i,2] := round((xpts[i,2] - midy) * sy) + midy;
  3835.      end;
  3836.  
  3837.   if (theta <> 0.0) then
  3838.     begin (* rotate about center *)
  3839.     for i := 0 to xknots do
  3840.       begin
  3841.       ptrotate (xpts[i,1], xpts[i,2], midx, midy, theta);
  3842.       end;
  3843.     end;
  3844.     (* translate *)
  3845.   for i := 0 to xknots do
  3846.     begin
  3847.     xpts[i,1] := (xpts[i,1] + round(dx * scalefact) + offh);
  3848.     xpts[i,2] := (xpts[i,2] + round(dy * scalefact) + offv);
  3849.     end;
  3850. end;  (* xfmcontpts *)
  3851.  
  3852.  
  3853. {----------------------------------------------------------------}
  3854. (* convert into DVI space and offset by H & V *)
  3855. procedure dvilinepts (var x1, y1, x2, y2 : ScaledPts;
  3856.             offh, offv : ScaledPts);
  3857. begin
  3858.    x1 := (x1  + offh);
  3859.    x2 := (x2  + offh);
  3860.    y1 := (y1 * (-1) + offv);
  3861.    y2 := (y2 * (-1) + offv);
  3862. end;
  3863.  
  3864. {----------------------------------------------------------------}
  3865. (* convert into DVI space and offset by H & V *)
  3866. procedure dvicontpts (var xpts : ControlPoints; xknots : integer;
  3867.                         offh, offv : ScaledPts);
  3868. var i : integer;
  3869. begin
  3870.   for i := 0 to xknots do
  3871.     begin
  3872.     xpts[i,1] := (xpts[i,1]  + offh);
  3873.     xpts[i,2] := (xpts[i,2] * (-1) + offv);
  3874.     end;
  3875. end;
  3876.  
  3877. {----------------------------------------------------------------}
  3878. (*    transform all the figure's elements according to the 
  3879.     top-level tranformation requirements in 1st Quadrant space.
  3880.     then reset the toplevel's xfms.
  3881. *)
  3882. procedure toplevelxfm (toplev, curfig : pItem; recurlevel : integer);
  3883. var pi : pItem;
  3884.     null1, null2 : ScaledPts;
  3885.     old1, old2 : ScaledPts;
  3886.     midx, midy : ScaledPts;
  3887. begin
  3888.   with toplev^ do
  3889.     begin
  3890.     midy := (BBty - BBby) div 2;
  3891.     midx := (BBrx - BBlx) div 2;
  3892.     end;
  3893.   pi := curfig^.body^.things;  { if recur==0, this is same as toplev }
  3894.   while (pi <> nil) do
  3895.     begin
  3896.     with pi^ do
  3897.       begin
  3898.       case (kind) of
  3899.     Aline : begin
  3900.         xfmlinepts (lx1, ly1, lx2, ly2, 0, 0, midx, midy, 1.0, 
  3901.               toplev^.figtheta, toplev^.fdx, toplev^.fdy,
  3902.               toplev^.fsx, toplev^.fsy);
  3903.         end;
  3904.     Aspline : begin
  3905.           xfmcontpts (spts, nsplknots, 0, 0, midx, midy, 1.0,
  3906.               toplev^.figtheta, toplev^.fdx, toplev^.fdy,
  3907.               toplev^.fsx, toplev^.fsy);
  3908.           end;
  3909.     Attspline : begin
  3910.           xfmcontpts (ttpts, nttknots, 0, 0, midx, midy, 1.0,
  3911.               toplev^.figtheta, toplev^.fdx, toplev^.fdy,
  3912.               toplev^.fsx, toplev^.fsy);
  3913.             end;
  3914.     Aarc : begin
  3915.            null1 := 0; null2 := 0;
  3916.            old1 := acentx; old2 := acenty;
  3917.            xfmlinepts (acentx, acenty, null1, null2, 0,0, midx, midy, 1.0,
  3918.             toplev^.figtheta, toplev^.fdx, toplev^.fdy,
  3919.             toplev^.fsx, toplev^.fsy);        
  3920.                   
  3921.            xfmcontpts (arcpts, narcknots + 1, 0, 0, old1, old2, 1.0,
  3922.               toplev^.figtheta, 
  3923.               toplev^.fdx + (acentx - old1), 
  3924.               toplev^.fdy + (acenty - old2),
  3925.               toplev^.fsx, toplev^.fsy);
  3926.            end;              
  3927.     Alabel : begin
  3928.          null1 := 0; null2 := 0;
  3929.          xfmlinepts (labx, laby, null1, null2, 0, 0, midx, midy, 1.0,
  3930.               toplev^.figtheta, toplev^.fdx, toplev^.fdy,
  3931.               toplev^.fsx, toplev^.fsy);        
  3932.          end;
  3933.     Abeam : ;   (* not transformable *)
  3934.  
  3935.     Atieslur: ; (* not transformable *)
  3936.  
  3937.     Afigure : begin
  3938.             toplevelxfm (toplev, pi, recurlevel + 1);
  3939.           end;
  3940.       end; (* case *)
  3941.     end; (* with *)
  3942.     pi := pi^.nextitem;
  3943.     end;  (* while *)
  3944.   if (recurlevel = 0) then
  3945.     begin (* reset the toplevel's xfms *)
  3946.     with toplev^ do
  3947.       begin
  3948.       figtheta := 0.0;
  3949.       fsx := 1.0; fsy := 1.0;
  3950.       fdx := 0;   fdy := 0;
  3951.       end;    
  3952.     end;
  3953. end;
  3954.  
  3955.  
  3956. {----------------------------------------------------------------}
  3957. function scalefitfactor (actualwid, actualht, 
  3958.              goalwid, goalht: ScaledPts): real;
  3959. var sx, sy : real;
  3960. begin
  3961.   sx := goalwid/actualwid;
  3962.   sy := goalht/actualht;
  3963.   if (sx < sy) then
  3964.     scalefitfactor := sx
  3965.   else
  3966.     scalefitfactor := sy;
  3967. end;  
  3968.  
  3969.  
  3970.  
  3971. (* ---- The handlers for each primitive ---- 
  3972.  *   The result of calling each handler is either immediate
  3973.  *       output to the buffer of the commands to produce the
  3974.  *       primitive, OR the primitive gets pushed onto a stack/list
  3975.  *       that defines a current 'figure' (set of prims) for
  3976.  *       output at a later time
  3977.  *
  3978.  *  Look at linehandle for a basic idea of how the handlers
  3979.  *  work. the others follow pretty closely.
  3980.  *)
  3981.  
  3982.  
  3983. {------------------------------------------------------------}
  3984. procedure linehandle (figdepth : integer; scalefact: real; 
  3985.                      x1, y1, x2, y2 : ScaledPts;
  3986.                      dvih, dviv : ScaledPts; (* possible dvi-offsets *)
  3987.                      thk : VThickness; vk : VectKind;
  3988.              patt : LineStyle;
  3989.              minx, maxx, miny, maxy : ScaledPts;
  3990.                      tx, ty: ScaledPts; sx, sy, r : real);
  3991. var midx, midy : ScaledPts;                  
  3992.     lineitem : pItem;
  3993. begin
  3994.    midx := (minx + maxx) div 2;
  3995.    midy := (miny + maxy) div 2;
  3996.  
  3997.     (* do local primitive -level transformations *)
  3998.    xfmlinepts (x1, y1, x2, y2, dvih, dviv,
  3999.                 midx, midy, scalefact, r, tx, ty, sx, sy);
  4000.  
  4001.    if (figdepth = 0) then 
  4002.      begin      (* ---- do the primitive by itself *)
  4003.       (* re-transform it to the 4th Quadrant *)
  4004.      dvilinepts (x1, y1, x2, y2, h, v);  (* global h and v posit *)
  4005.      IPUSH;
  4006.      TylLine (x1, y1, x2, y2, thk, vk, patt);
  4007.      IPOP;
  4008.      end
  4009.   else if (figdepth > 0) then
  4010.      begin      (* ---- Pack it and stack it *)
  4011.      lineitem := NewItem (Aline);
  4012.      with lineitem^ do
  4013.        begin
  4014.        BBlx := minx;     BBby := miny;
  4015.        BBrx := maxx;     BBty := maxy;
  4016.        lx1 := x1;     ly1 := y1;
  4017.        lx2 := x2;    ly2 := y2;
  4018.        itemthick := thk;
  4019.        itemvec := vk;
  4020.        itempatt := patt;
  4021.        end;  
  4022.      pushItem (figdepth, lineitem);
  4023.      end
  4024.    else if (figdepth < 0) then
  4025.      begin      (* ---- just do it right away without any PUSH/POP pair *)
  4026.              (* this is the case when we are unpacking a figure for
  4027.          *  immediate output
  4028.          *)
  4029.      TylLine (x1, y1, x2, y2, thk, vk, patt);
  4030.      end;  
  4031. end;  (*  linehandle *)
  4032.  
  4033.  
  4034. (* ---   Simple Splines -----*)
  4035. {-----------------------------------------------------}
  4036. procedure splinehandle (figdepth : integer; scalefact : real;
  4037.                         thetype : SplineKind; isclosed : boolean;
  4038.             markdiam : integer;
  4039.                         var contpts : ControlPoints;
  4040.                         nknots : integer;
  4041.                         dvih, dviv : ScaledPts; (* possible dvi-offsets *)
  4042.                         thk : VThickness; vec : VectKind;
  4043.             patt : LineStyle;
  4044.                         minx, maxx, miny, maxy : ScaledPts;
  4045.                         tx, ty : ScaledPts; sx, sy, r : real);
  4046. var midx, midy : ScaledPts;                     
  4047.     splineitem : pItem;
  4048.     i : integer;
  4049. begin
  4050.    midx := (minx + maxx) div 2;
  4051.    midy := (miny + maxy) div 2;
  4052.    
  4053.    xfmcontpts (contpts, nknots, dvih, dviv, midx, midy,
  4054.                 scalefact, r, tx, ty, sx, sy);
  4055.  
  4056.    if (figdepth = 0) then
  4057.      begin      (* ----  do the primitive *)
  4058.      (* transform to 4th quad *)
  4059.      dvicontpts (contpts, nknots, h, v);
  4060.      IPUSH;
  4061.      TylSpline (thetype, isclosed, contpts, nknots, thk, vec, patt, markdiam);
  4062.      IPOP;
  4063.      end
  4064.    else if (figdepth > 0) then
  4065.      begin
  4066.      splineitem := NewItem (Aspline);
  4067.      with splineitem^ do
  4068.        begin
  4069.        BBlx := minx; BBby := miny;
  4070.        BBrx := maxx; BBty := maxy;
  4071.        itemthick := thk;
  4072.        itemvec := vec;
  4073.        itempatt := patt;
  4074.        nsplknots := nknots;
  4075.        spltype := thetype;
  4076.        sclosed := isclosed;
  4077.        dosmarks := markdiam;
  4078.        for i := 1 to nknots do
  4079.          begin
  4080.          spts[i,1] := contpts[i,1];
  4081.          spts[i,2] := contpts[i,2];
  4082.          end;
  4083.        end;  
  4084.      pushItem (figdepth, splineitem);
  4085.      end
  4086.    else if (figdepth < 0) then
  4087.      begin
  4088.      TylSpline (thetype, isclosed, contpts, nknots, thk, vec, patt, markdiam);
  4089.      end;  
  4090. end;  (*  splinehandle *)
  4091.  
  4092.  
  4093. (* --- Variable thickness splines ----- *)
  4094. {-----------------------------------------------------}
  4095. procedure ttsplhandle (figdepth : integer; scalefact : real;
  4096.                         thetype : SplineKind; isclosed : boolean;
  4097.             markdiam : integer;
  4098.                         contpts : ControlPoints;
  4099.                         ttks : ThickAryType;
  4100.                         nknots : integer; 
  4101.                         dvih, dviv : ScaledPts; (* possible dvi-offsets *)
  4102.                         vec : VectKind;
  4103.             patt : LineStyle;
  4104.                         minx, maxx, miny, maxy : ScaledPts;
  4105.                         tx, ty : ScaledPts; sx, sy, r : real);
  4106. var midx, midy : ScaledPts;
  4107.     ttsplitem : pItem;
  4108.     i : integer;
  4109. begin
  4110.    midx := (minx + maxx) div 2;
  4111.    midy := (miny + maxy) div 2;
  4112.    
  4113.    xfmcontpts (contpts, nknots, dvih, dviv, midx, midy,
  4114.                 scalefact, r, tx, ty, sx, sy);
  4115.  
  4116.    if (figdepth = 0) then
  4117.      begin
  4118.      (* transform to 4th quad      *)
  4119.      dvicontpts (contpts, nknots, h, v);
  4120.      IPUSH;
  4121.      TylThickThinSpline (thetype, isclosed, contpts, ttks, nknots, vec, patt, markdiam);
  4122.      IPOP;
  4123.      end
  4124.    else if (figdepth > 0) then
  4125.      begin
  4126.      ttsplitem := NewItem (Attspline);
  4127.      with ttsplitem^ do
  4128.        begin
  4129.        BBlx := minx; BBby := miny;
  4130.        BBrx := maxx; BBty := maxy;
  4131.        itemvec := vec;
  4132.        itempatt := patt;
  4133.        nttknots := nknots;
  4134.        tspltype := thetype;
  4135.        dottmarks := markdiam;
  4136.        tclosed := isclosed;
  4137.        for i := 1 to nknots do
  4138.          begin
  4139.          ttpts[i,1] := contpts[i,1];
  4140.          ttpts[i,2] := contpts[i,2];
  4141.          ttarry[i] := ttks[i];
  4142.          end;
  4143.        end;  (*  ttsplitem *)
  4144.      pushItem (figdepth, ttsplitem);
  4145.      end
  4146.    else if (figdepth < 0) then
  4147.      begin
  4148.      TylThickThinSpline (thetype, isclosed, contpts, ttks, nknots, vec, patt, markdiam);
  4149.      end;  
  4150.   
  4151. end;  (*  ttsplhandle *)
  4152.  
  4153.  
  4154. (* ---- Musical Beams ---- *)
  4155. {-----------------------------------------------------}
  4156. procedure beamhandle (depth, siz : integer; bk : BeamKind;
  4157.                         x1, y1, x2, y2 : ScaledPts);
  4158. var bmitem : pItem;
  4159. begin
  4160.     if (depth = 0) then
  4161.       begin
  4162.       dvilinepts (x1, y1, x2, y2, h, v);
  4163.       IPUSH;
  4164.       TylBeam (x1, y1, x2, y2, siz, bk);
  4165.       IPOP;
  4166.       end
  4167.     else if (depth > 0) then
  4168.       begin
  4169.       bmitem := NewItem (Abeam);
  4170.       with bmitem^ do
  4171.         begin
  4172.         BBlx := min(x1, x2);     BBby := min(y1, y2);
  4173.         BBrx := max(x1, x2);     BBty := max(y1, y2);
  4174.     bx1 := x1;        by1 := y1;
  4175.     bx2 := x2;        by2 := y2;    
  4176.         staf := siz;
  4177.         bkind := bk;
  4178.         end;  (* with *)
  4179.       pushItem (depth, bmitem);
  4180.       end
  4181.     else if (depth < 0) then
  4182.       begin
  4183.       TylBeam (x1, y1, x2, y2, siz, bk);      
  4184.       end;  (* else *)
  4185. end;  (*  beamhandle *)
  4186.  
  4187.  
  4188. (* ---- Musical Ties and Slurs ----- *)
  4189. {-----------------------------------------------------}
  4190. procedure tieslurhandle (depth: integer; pts : ControlPoints;
  4191.                         numk : integer; minthick, maxthick : VThickness);
  4192. var tsitem : pItem;
  4193.     i : integer;
  4194. begin
  4195. if (depth = 0) then
  4196.    begin
  4197.      dvicontpts (pts, numk, h, v);
  4198.      IPUSH;
  4199.      TylTieSlur (pts, numk, minthick, maxthick);
  4200.      IPOP;
  4201.    end
  4202. else if (depth > 0) then
  4203.  begin
  4204.   tsitem := NewItem (Atieslur);
  4205.   with tsitem^ do
  4206.     begin
  4207.     ntknots := numk;
  4208.     for i := 1 to numk do 
  4209.       begin
  4210.       tspts[i,1] := pts[i,1];
  4211.       tspts[i,2] := pts[i,2];
  4212.       end;
  4213.     minth := minthick;
  4214.     maxth := maxthick;
  4215.     end;  (* with *)
  4216.   pushItem (depth, tsitem);
  4217.   end
  4218. else if (depth < 0) then
  4219.   begin
  4220.   TylTieSlur (pts, numk, minthick, maxthick);      
  4221.   end;  (* else *)
  4222. end;  (*  tieslurhandle *)
  4223.  
  4224.  
  4225. {---------------------------------------------------------}
  4226. procedure arccirclehandle (figdepth : integer; scalefact : real;
  4227.             cx, cy : ScaledPts;
  4228.             radius : ScaledPts;
  4229.             ang1, ang2 : integer;
  4230.             var contpts : ControlPoints; (* IN *)
  4231.             nknots : integer;
  4232.             dvih, dviv : ScaledPts; (* possible dvi-offsets *)
  4233.             thk : VThickness; vec : VectKind;
  4234.             patt : LineStyle;
  4235.             minx, maxx, miny, maxy : ScaledPts;
  4236.             tx, ty : ScaledPts; sx, sy, r : real);
  4237.  
  4238. var midx, midy : ScaledPts;                     
  4239.     middlex, middley : ScaledPts;
  4240.     arcitem : pItem;
  4241.     i : integer;
  4242.     isclosedarc : boolean;
  4243.  
  4244. begin
  4245.    midx := cx;  middlex := (minx + maxx) div 2;
  4246.    midy := cy;    middley := (miny + maxy) div 2;
  4247.    isclosedarc := (ang1 = ang2);
  4248. {
  4249.    if (isclosedarc) then
  4250.      maxspanlen := round ((360.0 / 16.0) * DEGTORAD * radius)
  4251.    else
  4252.      maxspanlen := round ((abs(ang2 - ang1) / 16.0) * DEGTORAD * radius);
  4253. { }
  4254.  
  4255.  
  4256.    xfmcontpts (contpts, nknots+1, dvih, dviv, midx, midy,
  4257.                 scalefact, r, tx, ty, sx, sy);
  4258.  
  4259.    if (figdepth = 0) then
  4260.      begin      (* ---- just do the primitive *)
  4261.      (* transform to 4th quad *)
  4262.      dvicontpts (contpts, nknots+1, h, v);
  4263.      IPUSH;
  4264.      doTylArc (isclosedarc, 
  4265.              contpts, nknots, thk, vec, patt); 
  4266.      IPOP;
  4267.      end
  4268.    else if (figdepth > 0) then
  4269.      begin
  4270.      arcitem := NewItem (Aarc);
  4271.      with arcitem^ do
  4272.        begin
  4273.        BBlx := minx; BBby := miny;
  4274.        BBrx := maxx; BBty := maxy;
  4275.        itemthick := thk;
  4276.        itemvec := vec;
  4277.        itempatt := patt;
  4278.        narcknots := nknots;
  4279.        acentx := cx;
  4280.        acenty := cy;
  4281.        aradius := radius;
  4282.        firstang := ang1;
  4283.        lastang := ang2;
  4284.        for i := 0 to nknots+1 do
  4285.          begin
  4286.          arcpts[i,1] := contpts[i,1];
  4287.          arcpts[i,2] := contpts[i,2];
  4288.          end;
  4289.        end;  
  4290.      pushItem (figdepth, arcitem);
  4291.      end
  4292.    else if (figdepth < 0) then
  4293.      begin
  4294.      doTylArc (isclosedarc, contpts, nknots, thk, vec, patt);
  4295.      end;  
  4296. end;  (*  arccirclehandle *)
  4297.  
  4298.  
  4299.  
  4300. {---------------------------------------------------------}
  4301. procedure labelhandle (depth : integer; scalefact: real; 
  4302.                        lax, lay : ScaledPts;
  4303.                        dvih, dviv : ScaledPts; (* possible dvi-offsets *)
  4304.                style : integer; 
  4305.                phrase : strng;
  4306.                tx, ty : ScaledPts);
  4307. var labitem : pItem;
  4308.     null1, null2 : ScaledPts;
  4309. begin
  4310. (* xfm the label point if necessary *)
  4311.   lax := lax + round(tx * scalefact);
  4312.   lay := lay + round(ty * scalefact);
  4313.  
  4314.   if (depth = 0) then
  4315.     begin
  4316.     null1 := 0; null2 := 0;
  4317.     dvilinepts (lax, lay, null1, null2, h, v);
  4318.     IPUSH;
  4319.     TylLabel (lax, lay, style, phrase.str, phrase.len);
  4320.     IPOP;
  4321.     end
  4322.   else if (depth > 0) then
  4323.     begin
  4324.     labitem := NewItem (Alabel);
  4325.     with labitem^ do
  4326.       begin
  4327.       labx := lax; 
  4328.       laby := lay;
  4329.       fontstyle := style;
  4330.       strcopy (phrase.str, labeltext.str, phrase.len);
  4331.       labeltext.len := phrase.len;
  4332.       end;  
  4333.     pushItem (depth, labitem);
  4334.     end  
  4335.   else if (depth < 0) then
  4336.     begin
  4337.     TylLabel (lax, lay, style, phrase.str, phrase.len);
  4338.     end; 
  4339. end;
  4340.  
  4341.  
  4342. (* ####   Insert new handlers here for new "primitives"
  4343.     i.e., names callable from the \special[tyl ...]  level 
  4344. *)
  4345.  
  4346.  
  4347.  
  4348. {----------------------------------------------------------------}
  4349. (*  transform the current bbox coordinates, and output the new one *)
  4350. procedure newbbox (var minx, maxx, miny, maxy : ScaledPts;
  4351.                    midx, midy : ScaledPts;
  4352.                    sx, sy, rot : real; tx, ty : ScaledPts);
  4353. var
  4354.       (* coords of full bbox for transformation [n/s][e/w][x/y] *)
  4355.    nex, ney, sex, sey, swx, swy, nwx, nwy: ScaledPts; 
  4356.    temp1, temp2 : integer;
  4357. begin
  4358.   (* describe  and transform the bbox *)
  4359.   nwx := round (minx * sx);      nex := round (maxx * sx);
  4360.   sex := round (maxx * sx);      swx := round (minx * sx);
  4361.   ney := round (maxy * sy);      nwy := round (maxy * sy);
  4362.   swy := round (miny * sy);      sey := round (miny * sy);
  4363.   
  4364.   ptrotate (nex, ney, midx, midy, rot);
  4365.   ptrotate (sex, sey, midx, midy, rot);
  4366.   ptrotate (swx, swy, midx, midy, rot);
  4367.   ptrotate (nwx, nwy, midx, midy, rot);
  4368.   
  4369.   nex := nex + tx; sex := sex + tx;
  4370.   swx := swx + tx; nwx := nwx + tx;
  4371.   ney := ney + ty; sey := sey + ty;
  4372.   swy := swy + ty; nwy := nwy + ty;
  4373.   (* now find the actual extents of the bbox *)
  4374.   temp1 := min (nex, nwx);
  4375.   temp2 := min (swx, sex);
  4376.   minx := min (temp1, temp2);
  4377.   
  4378.   temp1 := min (ney, nwy);
  4379.   temp2 := min (swy, sey);
  4380.   miny := min (temp1, temp2);
  4381.     
  4382.   temp1 := max (nex, nwx);
  4383.   temp2 := max (swx, sex);
  4384.   maxx := max (temp1, temp2);
  4385.   
  4386.   temp1 := max (ney, nwy);
  4387.   temp2 := max (swy, sey);
  4388.   maxy := max (temp1, temp2);      
  4389. end;
  4390.       
  4391.      
  4392. {-----------------------------------------------}
  4393. (* find the bounding box of the list of primitives  
  4394.     and/or sub-figures in this Item *)
  4395.  
  4396. procedure findBBox (blot : pItem; 
  4397.                 var mnx, mxx, mny, mxy : ScaledPts);
  4398. var 
  4399.    pi : pItem;
  4400.    bmnx, bmxx, bmny, bmxy, midx, midy : ScaledPts; (* bbox [min/max][x/y] *)
  4401.    tmnx, tmxx, tmny, tmxy : ScaledPts;  (* temporary, in case of recursion *)
  4402.    null1, null2 : ScaledPts;
  4403.    prescale, postscale : real;
  4404.    old1, old2 : ScaledPts;
  4405. begin
  4406.   bmnx := TWO24; bmny := TWO24;
  4407.   bmxx := -TWO24; bmxy :=-TWO24;
  4408.   if (blot^.kind = Afigure) then
  4409.     begin (* afigure *)
  4410.     pi := blot^.body^.things;
  4411.     while (pi <> nil) do
  4412.       begin (* find the current bbox of the list of items here *)
  4413.       if (pi^.kind = Afigure) then
  4414.         begin  (* recur *)
  4415.         findBBox (pi, tmnx, tmxx, tmny, tmxy);
  4416.         bmnx := min (bmnx, tmnx);
  4417.         bmny := min (bmny, tmny);
  4418.         bmxx := max (bmxx, tmxx);
  4419.         bmxy := max (bmxy, tmxy);
  4420.         end
  4421.       else
  4422.         begin
  4423.         bmnx := min (bmnx, pi^.BBlx);
  4424.         bmny := min (bmny, pi^.BBby);
  4425.         bmxx := max (bmxx, pi^.BBrx);
  4426.         bmxy := max (bmxy, pi^.BBty);
  4427.         end;
  4428.       pi := pi^.nextitem;
  4429.       end;  (* while *)
  4430.         (* now transform the items inside, AND the bbox *)
  4431.     pi := blot^.body^.things;
  4432.     midx := (bmnx + bmxx) div 2;
  4433.     midy := (bmny + bmxy) div 2;
  4434.     (* now take care of any pre and post size requirements *)
  4435.     (* see also the "figurehandle" proc. *)
  4436.      with blot^ do
  4437.       begin  
  4438. (* ### Keep this scaling biz here, too, for now. May blast it later *)
  4439.       if ((preWid <> 0) and (preHt <> 0)) then
  4440.     begin
  4441.     prescale := scalefitfactor ((bmxx - bmnx), (bmxy - bmny), preWid, preHt);
  4442.     fsx := fsx * prescale;
  4443.     fsy := fsy * prescale;
  4444.     end;
  4445.       if ((postWid <> 0) and (postHt <> 0)) then
  4446.     begin
  4447.     postscale := scalefitfactor ((bmxx - bmnx), (bmxy - bmny), postWid, postHt);
  4448.     fsx := fsx * postscale;
  4449.     fsy := fsy * postscale;
  4450.     end;
  4451.  
  4452. (* the actual scale-up is taken care of later in this proc. *)
  4453.       end; (* with *)  
  4454.     while (pi <> nil) do
  4455.       begin
  4456.       with pi^ do
  4457.         begin
  4458.         case (kind) of
  4459.           Aline : begin
  4460.                   xfmlinepts (lx1, ly1, lx2, ly2, 0, 0, midx, midy, 1.0, 
  4461.                         blot^.figtheta, blot^.fdx, blot^.fdy,
  4462.                         blot^.fsx, blot^.fsy);
  4463.                   end;
  4464.           Aspline : begin
  4465.                     xfmcontpts (spts, nsplknots, 0, 0, midx, midy, 1.0,
  4466.                         blot^.figtheta, blot^.fdx, blot^.fdy,
  4467.                         blot^.fsx, blot^.fsy);
  4468.                     end;
  4469.           Attspline : begin
  4470.                       xfmcontpts (ttpts, nttknots, 0, 0, midx, midy, 1.0,
  4471.                         blot^.figtheta, blot^.fdx, blot^.fdy,
  4472.                         blot^.fsx, blot^.fsy);
  4473.                       end;
  4474.       Aarc : begin
  4475.          null1 := 0; null2 := 0;
  4476.          old1 := acentx; old2 := acenty;
  4477.            xfmlinepts (acentx, acenty, null1, null2, 0,0, midx, midy, 1.0,
  4478.                         blot^.figtheta, blot^.fdx, blot^.fdy,
  4479.                         blot^.fsx, blot^.fsy);
  4480.            xfmcontpts (arcpts, narcknots + 1, 0, 0, old1, old2, 1.0,
  4481.                         blot^.figtheta, 
  4482.             blot^.fdx + (acentx - old1),
  4483.             blot^.fdy + (acenty - old2),
  4484.                         blot^.fsx, blot^.fsy);
  4485.                  end;              
  4486.       Alabel : begin
  4487.            null1 := 0; null2 := 0;
  4488.              xfmlinepts (labx, laby, null1, null2, 0,0, midx, midy, 1.0,
  4489.                         blot^.figtheta, blot^.fdx, blot^.fdy,
  4490.                         blot^.fsx, blot^.fsy);        
  4491.            end;
  4492.           Abeam : ;   (* not transformable *)
  4493.  
  4494.           Atieslur: ; (* not transformable *)
  4495.           Afigure : ; (* do not need to re-transform *)
  4496.         end; (* case *)
  4497.       end; (* with *)
  4498.       pi := pi^.nextitem;
  4499.       end;  (* while *)
  4500.     (* transform the bbox, and re-find the new bbox *)
  4501.     newbbox (bmnx, bmxx, bmny, bmxy, midx, midy, blot^.fsx, blot^.fsy,
  4502.                 blot^.figtheta, blot^.fdx, blot^.fdy);
  4503.     mnx := bmnx; mny := bmny;
  4504.     mxx := bmxx; mxy := bmxy;
  4505.     end  (* if *)
  4506.   else (* some other primitive *)
  4507.     begin
  4508.     mnx := blot^.BBlx; mny := blot^.BBby;
  4509.     mxx := blot^.BBrx; mxy := blot^.BBty;
  4510.     end;  (* else *)
  4511. end;  (*  findBBox *)
  4512.  
  4513.  
  4514. {---------------------------------------------------------}
  4515. (* traverse the list, determining the current bounding box for
  4516.  *       the items. We need this to find the mid-point
  4517.  *       for doing any remaining rotations 
  4518.  *)
  4519. procedure traverse (thefig, theitem : pItem);
  4520. var 
  4521.     minx, maxx, miny, maxy : ScaledPts;  
  4522.     curminx, curmaxx, curminy, curmaxy : ScaledPts;  
  4523. begin
  4524.   minx := TWO24; maxx := -TWO24;
  4525.   miny := TWO24; maxy := -TWO24;
  4526.   
  4527.   while (theitem <> nil) do
  4528.     begin
  4529.     if (theitem^.kind = Afigure) then
  4530.       begin (* recur *)
  4531.       findBBox (theitem, curminx, curmaxx, curminy, curmaxy);
  4532.       with theitem^ do
  4533.         begin
  4534.         BBlx := curminx;         BBby := curminy;
  4535.         BBrx := curmaxx;         BBty := curmaxy;
  4536.            (* reset the symbol's parameters since all the
  4537.                 primitives in it have now been transformed
  4538.                 according to the previous specifications *)
  4539.         figtheta := 0.0; 
  4540.         fsx := 1.0;      fsy := 1.0;
  4541.         fdx := 0;        fdy := 0;
  4542.     preWid := 0;     preHt := 0;
  4543.     postWid := 0;     postHt := 0;
  4544.         end;  (* with *)
  4545.       minx := min (minx, curminx);      miny := min (miny, curminy);
  4546.       maxx := max (maxx, curmaxx);      maxy := max (maxy, curmaxy);
  4547.       end  (* if a figure/symbol*)
  4548.     else
  4549.       begin  (* a primitive *)
  4550.       with theitem^ do 
  4551.         begin
  4552.         minx := min (minx, BBlx);        miny := min (miny, BBby);
  4553.         maxx := max (maxx, BBrx);        maxy := max (maxy, BBty);
  4554.         end;  (* with *)
  4555.       end;  (* else *)
  4556.     theitem := theitem^.nextitem;
  4557.     end;  (* while *)
  4558.  
  4559.   with thefig^ do
  4560.     begin  (* set the bounding box for this upper-level symbol defn *)
  4561.     BBlx := minx;
  4562.     BBby := miny;
  4563.     BBrx := maxx;
  4564.     BBty := maxy;
  4565.     end;  (* with *)
  4566. end;  (* traverse *)
  4567.  
  4568. (* ----- Figure symbols ----- *)
  4569. {---------------------------------------------------}
  4570. procedure figurehandle (globalsymlist, symbollist : pItem; dopush : integer);
  4571. const DoItNow = -1;
  4572.       NoScale = 1;
  4573. var pi, curfig : pItem;
  4574.     midx, midy : ScaledPts;
  4575.     null1, null2 : ScaledPts;
  4576.     prescale, postscale : real;
  4577.     tmnx, tmny, tmxx, tmxy : ScaledPts;
  4578. begin (* figurehandle *)
  4579.  
  4580.     (* PUSH. traverse the lists (recursively if necessary) and 
  4581.      * compute the transformed points.
  4582.      * Convert to 4th quadrant and offset by H & V.
  4583.      * We can do this destructively here
  4584.      * since we're going to output them right away anyhow.
  4585.      * Then call each respective primitive handler with a level
  4586.      * of -1 to indicate  to do its job immediately. 
  4587.      * POP.     
  4588.      *)
  4589.   curfig := symbollist;
  4590.   pi := curfig^.body^.things;
  4591.         (* find and set the bounding box for
  4592.          the figure's sub-symbols and primitives *)
  4593.   if (dopush > 0) then
  4594.     traverse (curfig, pi); 
  4595.   
  4596.       (* We eventually transform the items
  4597.      to 4th Quadrant DVI space and output them! *)
  4598.  
  4599.   pi := curfig^.body^.things;
  4600.  
  4601.   midy := (globalsymlist^.BBby + globalsymlist^.BBty) div 2;
  4602.   midx := (globalsymlist^.BBlx + globalsymlist^.BBrx) div 2;
  4603.  
  4604.   if (dopush > 0) then 
  4605.     begin (* the top-level figure for outputting *)
  4606.  
  4607.     (* convert the bounding box because we are about to enter
  4608.         into DVI space, and all calls to handlers hereafter
  4609.     are in terms of DVI coordinates *)
  4610.  
  4611.       with globalsymlist^ do
  4612.         begin 
  4613.  
  4614. (* Since there were external specifications about this figure,
  4615.     fit the current figure's actual size to the 
  4616.     "pre" size (specified by W marker) and/or to the
  4617.     "post" size (specified by the F marker). 
  4618.     We do this by simple scaling, *without* changing the midpoint
  4619.     of the bounding box, just its extents
  4620.  *)
  4621.     if ((preWid <> 0) and (preHt <> 0)) then
  4622.       begin
  4623.       prescale := scalefitfactor ((BBrx - BBlx), (BBty - BBby), preWid, preHt);
  4624.       fsx := fsx * prescale;
  4625.       fsy := fsy * prescale;
  4626.       end;
  4627.     if ((postWid <> 0) and (postHt <> 0)) then
  4628.       begin
  4629.       postscale := scalefitfactor ((BBrx - BBlx), (BBty - BBby), postWid, postHt);
  4630.       fsx := fsx * postscale;
  4631.       fsy := fsy * postscale;
  4632.       end;
  4633.     tmnx := BBlx; tmny := BBby; tmxx := BBrx; tmxy := BBty;
  4634.     xfmlinepts (tmnx, tmny, tmxx, tmxy, 0,0, midx, midy, 1.0,
  4635.             0.0, 0, 0, fsx, fsy);
  4636.  
  4637.     toplevelxfm (globalsymlist, globalsymlist, 0);
  4638.     
  4639.     dviBBlx := tmnx; 
  4640.     dviBBrx := tmxx; 
  4641.     dviBBby := tmny;
  4642.     dviBBty := tmxy;
  4643.  
  4644.     xfmlinepts (dviBBlx, dviBBby, dviBBrx, dviBBty, 0,0,
  4645.         midx, midy, 1.0, 0.0,
  4646.         - (tmnx - BBlx), - (tmny - BBby),
  4647.         1.0, 1.0);
  4648.  
  4649.     fdx := fdx - (tmnx - BBlx);
  4650.     fdy := fdy - (tmny - BBby);
  4651.     end;
  4652.  
  4653.       dvilinepts (dviBBlx, dviBBby, dviBBrx, dviBBty, h, v);
  4654.       pgfigurenum := pgfigurenum + 1;
  4655.  
  4656.     (* We are ready to output the figure to the page *)
  4657.       writeln(logfile);
  4658.       write(logfile,'Figure #',pgfigurenum:0,' on page ',currpagenum:0,' is approx. ');
  4659. {      write(logfile,((globalsymlist^.BBty - globalsymlist^.BBby) div SPPERPT):0,' pts high and ');
  4660.       writeln(logfile,((globalsymlist^.BBrx - globalsymlist^.BBlx) div SPPERPT):0,' pts wide (actual size)');
  4661. }
  4662.     write(logfile,((tmxy - tmny) div SPPERPT):0,' pts high and ');
  4663.     writeln(logfile,((tmxx - tmnx) div SPPERPT):0,' pts wide (actual size)');
  4664.       IPUSH;  
  4665.  
  4666.     end;
  4667.  
  4668.   while (pi <> nil) do
  4669.     begin
  4670.     with pi^ do
  4671.         begin
  4672.         case (kind) of
  4673.           Aline : begin
  4674.                  dvilinepts (lx1, ly1, lx2, ly2, h, v); (* DVI h and v posit *)
  4675.                  with globalsymlist^ do
  4676.                  linehandle (DoItNow, NoScale, 
  4677.                                 pi^.lx1, pi^.ly1, pi^.lx2, pi^.ly2,
  4678.                                 0, 0,  
  4679.                                 pi^.itemthick, pi^.itemvec, pi^.itempatt,
  4680.                 dviBBlx, dviBBrx, dviBBby, dviBBty,
  4681.                                 fdx, -fdy, fsx, fsy, -figtheta);
  4682.                  end; (* Aline *)
  4683.          
  4684.          Aspline : begin
  4685.                    dvicontpts (spts, nsplknots, h, v);
  4686.                    with globalsymlist^ do
  4687.                    splinehandle (DoItNow, NoScale, pi^.spltype, 
  4688.                    pi^.sclosed, pi^.dosmarks,
  4689.                                 pi^.spts, pi^.nsplknots,
  4690.                                 0, 0,
  4691.                                 pi^.itemthick, pi^.itemvec, pi^.itempatt,
  4692.                                 dviBBlx, dviBBrx, dviBBby, dviBBty,
  4693.                                 fdx, -fdy, fsx, fsy, -figtheta);
  4694.                   end; (* Aspline *)
  4695.          
  4696.           Attspline : begin
  4697.                    dvicontpts (ttpts, nttknots, h, v);
  4698.                    with globalsymlist^ do
  4699.                    ttsplhandle (DoItNow, NoScale, pi^.tspltype, 
  4700.                    pi^.tclosed, pi^.dottmarks,
  4701.                                 pi^.ttpts, pi^.ttarry, pi^.nttknots,
  4702.                                 0, 0,
  4703.                                 pi^.itemvec, pi^.itempatt,
  4704.                                 dviBBlx, dviBBrx, dviBBby, dviBBty,
  4705.                                 fdx, -fdy, fsx, fsy, -figtheta);
  4706.                   end; (* Attspline *)
  4707.  
  4708.           Abeam : begin 
  4709.                   dvilinepts (bx1, by1, bx2, by2, h, v);
  4710.                   beamhandle (DoItNow, staf, bkind, bx1, by1, bx2, by2);
  4711.                   end; (* Abeam *)
  4712.  
  4713.           Atieslur : begin
  4714.                      dvicontpts (tspts, ntknots, h, v);
  4715.                      tieslurhandle (DoItNow, tspts, ntknots, minth, maxth);
  4716.                      end;  (* a tie or slur *)
  4717.  
  4718.       Aarc : begin
  4719.                    dvicontpts (arcpts, narcknots + 1, h, v);
  4720.                    with globalsymlist^ do
  4721.                    arccirclehandle (DoItNow, NoScale,
  4722.                 pi^.acentx, pi^.acenty,
  4723.                 pi^.aradius,
  4724.                 pi^.firstang, pi^.lastang,
  4725.                 pi^.arcpts, pi^.narcknots,
  4726.                 0, 0,
  4727.                 pi^.itemthick, pi^.itemvec, pi^.itempatt,
  4728.                                 dviBBlx, dviBBrx, dviBBby, dviBBty,
  4729.                 fdx, -fdy, fsx, fsy, -figtheta);
  4730.            end; (* arc *)
  4731.       Alabel : begin
  4732.              null1 := 0; null2 := 0;
  4733.              dvilinepts (labx, laby, null1, null2, h, v);
  4734.            with globalsymlist^ do
  4735.            labelhandle (DoItNow, NoScale,
  4736.                    pi^.labx, pi^.laby, 
  4737.                 0, 0,
  4738.                 pi^.fontstyle, pi^.labeltext,
  4739.                 fdx, -fdy);
  4740.           end; (* label *)
  4741.  
  4742.           Afigure : begin (* recur *)
  4743.                     figurehandle (globalsymlist, pi, 0);
  4744.                     end; (* another symbol *)
  4745.  
  4746.         end; (* case *)
  4747.       end; (* with *)
  4748.     pi := pi^.nextitem;
  4749.     end; (* while *)
  4750.   if (dopush > 0) then 
  4751.     begin
  4752.     IPOP;
  4753.     end;
  4754. end;  (*  figurehandle *)
  4755.  
  4756.  
  4757.  
  4758. (* %%% *)
  4759. {-----------------------------------------------------}
  4760. procedure mainhandlespecials (specnum, numpbytes : integer);
  4761. (* specnum is the DVI-number of the special
  4762.  * numpbytes is the number of parameter bytes
  4763.  *)
  4764. label 888;
  4765. const PARSLEN = 50;  (* Length of the byte-string-cache *)
  4766.       EMPTY = 0;
  4767. type charset = set of char;
  4768. var siz, numknots : integer;  (* Lots of temp vars that we use *)
  4769.      x1, y1, x2, y2 : integer;
  4770.      sx100, sy100 : real;
  4771.      transx, transy : ScaledPts;
  4772.      rot : real;
  4773.      SPscale : real;
  4774.      cpts : ControlPoints;
  4775.      thk : VThickness;
  4776.      patt : LineStyle;
  4777.      TTary : ThickAryType;
  4778.      vk : VectKind;
  4779.      bk : BeamKind;
  4780.      markdiam : integer;
  4781.      radius, ang1, ang2 : integer;
  4782.      phrase : strng;
  4783.      style : integer;
  4784.      nam : strng;
  4785.      sysnam : strng;    (* the first parameter of the \special *)
  4786.      let : char;
  4787.      i, gotten : integer;
  4788.      b : OctByt;
  4789.      pi : pItem;
  4790.      minx, miny, maxx, maxy : ScaledPts;
  4791.      maxthk, minthk : integer;
  4792.  
  4793.      tylnam,
  4794.      beginfigurenam,    (* names used for string to string comparisons *)
  4795.      endfigurenam,
  4796.      linenam,
  4797.      splinenam,
  4798.      ttsplnam,
  4799.      beamnam,
  4800.      tieslurnam,
  4801.      arcnam,
  4802.      labelnam,
  4803.      paramnam {internal} : charstring;
  4804.  
  4805.      splinetype : SplineKind;
  4806.      isclosedspline : boolean;
  4807.  
  4808.      parsearray : array [1..PARSLEN] of OctByt; (* cache of bytes to run through *)
  4809.      parsposit, parsmax : integer; (* current and max position in cache *)
  4810.      usingstream : boolean;    (* whether we read/parse using cache or from file *)
  4811.  
  4812.  
  4813. (*--------------------------------------------------------------
  4814.       These procedures depend on the correct ordering of
  4815.       GETs with respect to the number of bytes read in so far.
  4816.       precond: byte "b" has been read and gotten < numpbytes
  4817.       postcond: byte "b" has been read iff gotten < numpbytes.
  4818.       If your impl. definition of READ is non-standard, you will
  4819.       have to dink with the ordering and be really careful of
  4820.       keeping track of 'gotten' and 'numpbytes' variables 
  4821. --------------------------------------------------------------*)      
  4822.  
  4823.         function nextpbyte : integer;
  4824.         begin
  4825.           if (usingstream) then
  4826.             begin
  4827.             if (gotten < numpbytes) then
  4828.               begin
  4829.               nextpbyte := Dget1byte; 
  4830.               gotten := gotten + 1;
  4831.               end
  4832.             else
  4833.               nextpbyte := EMPTY;
  4834.             end
  4835.           else
  4836.             begin (* not using stream *)
  4837.             if (parsposit <= parsmax) then
  4838.               begin
  4839.               nextpbyte := parsearray[parsposit];
  4840.               parsposit := parsposit + 1;
  4841.               end
  4842.             else
  4843.               begin     (* at end of parse array, so read from stream now *)
  4844.               usingstream := true;
  4845.               if (gotten < numpbytes) then
  4846.                 begin
  4847.                 nextpbyte := Dget1byte;
  4848.                 gotten := gotten + 1;
  4849.                 end
  4850.               else
  4851.                 nextpbyte := EMPTY;
  4852.               end;
  4853.             end;  (* else *)
  4854.         end;        
  4855.         
  4856. (* !!!!! Make sure all these predicates jive correctly with
  4857.     the key-letter definitions          *) 
  4858. {__________________________________________________________________}
  4859.         function isanumber (b : integer) : boolean;
  4860.         begin
  4861.           isanumber :=  ((b >= xord['0']) and (b <= xord['9']));
  4862.         end;
  4863.         
  4864.         function isaletter (b : integer) : boolean;
  4865.         begin
  4866.           isaletter := (((b >= xord['A']) and (b <= xord['Z'])) or
  4867.                         ((b >= xord['a']) and (b <= xord['z'])) or
  4868.              (b = xord['@']) or
  4869.              (b = xord['"']) );
  4870.         end;
  4871.         
  4872.         function isaspace (b : integer) : boolean;
  4873.         begin
  4874.           isaspace := ((b = xord[' ']) or 
  4875.                  (b = CR) or
  4876.                (b = LF) or
  4877.                (b = HT) or
  4878.                (b = FF));
  4879.         end;
  4880.         
  4881.         function isdelimiter (b : integer) : boolean;
  4882.         begin
  4883.           (* not a key-letter *)
  4884.           isdelimiter := (((b < xord['A']) or (b > xord['Z'])) and
  4885.                          ((b < xord['a']) or (b > xord['z'])) and
  4886.              (b <> xord['@']) and
  4887.              (b <> xord['"']) );
  4888.         end;
  4889.       
  4890.         function isnotnull (b : integer) : boolean;
  4891.         begin
  4892.           isnotnull := (b <> EMPTY);
  4893.         end;
  4894.         
  4895.         
  4896. {__________________________________________________________________}
  4897.         function getnumber : integer;
  4898.         var n : integer;
  4899.             isneg : boolean;
  4900.         begin
  4901.           n := 0;
  4902.           isneg := false;
  4903.           while (  (isnotnull (b)) and
  4904.                   (not (isanumber (b)))) do
  4905.             begin       (* not a numeral *)
  4906.             if (b = xord['-']) then
  4907.               isneg := true;
  4908.             b := nextpbyte;
  4909.             end;
  4910.     
  4911.       while (isaspace (b)) do  (* Skip spaces *)
  4912.         b := nextpbyte;
  4913.  
  4914.           while ( (isnotnull (b)) and
  4915.                  isanumber (b)) do
  4916.             begin (* a numeral *)
  4917.             n := n * 10 + (b - xord['0']);
  4918.             b := nextpbyte;
  4919.             end;
  4920.  
  4921.           if ((gotten = numpbytes)  and
  4922.                  isanumber (b)) then
  4923.             begin  (* end condition *)
  4924.             n := n * 10 + (b - xord['0']);
  4925.             end; 
  4926.  
  4927.           if (isneg) then
  4928.             getnumber := -(n)
  4929.           else
  4930.             getnumber := n;
  4931.         end;
  4932. {__________________________________________________________________}
  4933.  
  4934.         function getletter : char;
  4935.         var k : char;
  4936.         begin
  4937.           k := ' ';
  4938.           while ( (isnotnull (b)) and
  4939.                    (isdelimiter (b) and not (isaspace (b)))) do
  4940.             begin (* non letter *)
  4941.             b := nextpbyte;
  4942.             end;
  4943.  
  4944.          if  ( (isnotnull (b)) and
  4945.                 ( isaletter (b) or isaspace (b)
  4946.                  and not (isanumber (b)))) then
  4947.           begin
  4948.             k := xchr[b];
  4949.             b := nextpbyte;
  4950.           end;
  4951.         getletter := k;
  4952.         end;
  4953. {__________________________________________________________________}
  4954.  
  4955.         function getanything : char;
  4956.         var k : char;
  4957.         begin
  4958.           k := ' ';
  4959.           while (not (isnotnull (b))) do
  4960.             begin (* not usable *)
  4961.             b := nextpbyte;
  4962.             end;
  4963.  
  4964.          if (isnotnull (b)) then
  4965.           begin
  4966.             k := xchr[b];
  4967.             b := nextpbyte;
  4968.           end;
  4969.         getanything := k;
  4970.         end;
  4971.  
  4972. {****************************************************
  4973.    The following routines look for key - letter tokens
  4974.   that indicate certain attributes for a primitive.
  4975.  
  4976. Currently, the letters used are:
  4977.     S    for scaled-points measurement
  4978.     P    for printers points
  4979.     M    millimeters measurement
  4980.     C    use a Circular vector for drawing
  4981.     H    Horizontal-pen vector
  4982.     V    Vertical vector
  4983.     B    B-spline
  4984.     I    Interpolating B-spline
  4985.     K    Catmull-Rom spline
  4986.     D    Cardinal spline
  4987.     U    Open spline
  4988.     O    closed spline
  4989.     X    put marks on spline control pts
  4990.     T    Transformation marker
  4991.     R    Regular beam characters
  4992.     G    Grace Beam characters
  4993.     @    Specify center-point for arc/circle
  4994.     L    Line-style 
  4995.     F    for beginfigure: Fit figure to wid/ht
  4996.     W    for beginfigure: figure was created at this wid & ht
  4997. **************************************************}
  4998.  
  4999.  
  5000. {__________________________________________________________________}
  5001.         procedure gettransforms (var sc1, sc2, r : real;
  5002.                                 var tr1, tr2 : integer);
  5003.         label 22;
  5004.         var i : integer;                                
  5005.             dun : boolean;
  5006.         begin
  5007.           sc1 := 1.0; sc2 := 1.0;
  5008.           tr1 := 0; tr2 := 0;
  5009.           r := 0.0;
  5010.           i := parsposit - 1;
  5011.           if (i < 1) then
  5012.             begin
  5013.             goto 22; (* exit with defaults *)
  5014.             end;
  5015.           dun := false;
  5016.           while ((i < parsmax) and not dun) do
  5017.             begin
  5018.             if (isaletter(parsearray[i])) then
  5019.               begin
  5020.               if ((parsearray[i] = xord['t']) or
  5021.                   (parsearray[i] = xord['T'])) then
  5022.                  begin
  5023.                  if (isdelimiter(parsearray[i+1]) and
  5024.              isdelimiter(parsearray[i-1])) then
  5025.                     begin        (* get transform parameters *)
  5026.                     sc1 := getnumber / 100.0;
  5027.                     sc2 := getnumber / 100.0;
  5028.                     tr1 := getnumber;
  5029.                     tr2 := getnumber;
  5030.                     r := float(getnumber); (* degrees about primitive center *)
  5031.             if (r < 0.0) then
  5032.               r := r + 360.0;
  5033.                     dun := true;
  5034.                     end;
  5035.                  end;
  5036.               end;
  5037.             i := i + 1;
  5038.             end; (* while *)
  5039. 22:
  5040.         end; (* gettransforms *)
  5041.  
  5042. {__________________________________________________________________}
  5043.         function findmarker (markset : charset) : integer;
  5044.         label 1111;
  5045.         var i, sym : integer;
  5046.            dun : boolean;
  5047.         begin
  5048.         i := parsposit - 1;
  5049.         sym := EMPTY;
  5050.         if (i < 1) then
  5051.           goto 1111;
  5052.         dun := false;
  5053.         while ((i < parsmax) and not dun) do
  5054.           begin
  5055.           if (isaletter(parsearray[i])) then
  5056.             begin
  5057.             if (xchr[ parsearray[i] ] in markset) then
  5058.                 begin
  5059.                 if (isdelimiter (parsearray[i+1]) and
  5060.             isdelimiter (parsearray[i-1])) then
  5061.                   begin
  5062.                   sym := xord[tolowercase(xchr[parsearray[i]])];
  5063.                   dun := true;
  5064.                   end;
  5065.                 end;
  5066.             end;  (* if a letter *)
  5067.           i := i + 1;
  5068.           end;  (* while *)
  5069. 1111:     findmarker := sym;
  5070.         end;
  5071.  
  5072.  
  5073.  
  5074.         function findscale : integer;
  5075.         begin
  5076.           findscale := findmarker(['s','S','p','P','m','M']);
  5077.         end;
  5078.  
  5079.         function findvectkind : integer;
  5080.         begin
  5081.           findvectkind := findmarker(['c','C','h','H','v','V']);
  5082.         end;  
  5083.     
  5084.     function findlinestyle : integer;
  5085.     begin
  5086.       findlinestyle := findmarker(['l','L']);
  5087.     end;
  5088.  
  5089.         function findbeamkind : integer;
  5090.         begin
  5091.           findbeamkind := findmarker(['r','R','g','G']);
  5092.         end;
  5093.  
  5094.         function findsplinekind : integer;
  5095.         begin
  5096.           findsplinekind := findmarker(['b','B','i','I','k','K','d','D']);
  5097.         end;
  5098.  
  5099.         function findsplclosure : integer;
  5100.         begin
  5101.           findsplclosure := findmarker(['o','O','u','U']);
  5102.         end;
  5103.  
  5104.         function findatsign : integer;
  5105.         begin
  5106.           findatsign := findmarker(['@']);
  5107.         end;
  5108.     
  5109.     function finddotmark : integer;
  5110.     begin
  5111.       finddotmark := findmarker(['x','X']);
  5112.     end;
  5113.     
  5114.     function findfigdimens : integer;
  5115.     begin
  5116.       findfigdimens := findmarker(['w','W']);
  5117.     end;  
  5118.     
  5119.     function findfitsizes : integer;
  5120.     begin
  5121.       findfitsizes := findmarker(['f','F']);
  5122.     end;
  5123.  
  5124.  
  5125.    {_________________________________________________}
  5126.    function thescaleof (scal : integer) : real;
  5127.    begin
  5128.     if (scal = xord['s']) then
  5129.      thescaleof := 1 * magfactor
  5130.     else if (scal = xord['p']) then
  5131.      thescaleof := SPPERPT * magfactor
  5132.     else if (scal = xord['m']) then
  5133.      thescaleof := SPPERMM * magfactor
  5134.     else if (scal = EMPTY) then
  5135.      thescaleof := SPPERPT * magfactor;
  5136.    end;
  5137.     
  5138.  
  5139.    function thevectorof (vkin : integer) : VectKind;
  5140.    begin
  5141.      if (vkin = xord['c']) then
  5142.        thevectorof := VKCirc
  5143.      else if (vkin = xord['v']) then
  5144.        thevectorof := VKVert
  5145.      else if (vkin = xord['h']) then
  5146.        thevectorof := VKHort
  5147.      else if (vkin = EMPTY) then
  5148.        thevectorof := VKCirc;
  5149.    end;
  5150.    
  5151.    function thestyleof (linest : integer) : LineStyle;
  5152.    begin
  5153.      if ((linest > 3) or 
  5154.          (linest < 0)) then linest := 0;
  5155.      case linest of
  5156.         0 : thestyleof := solid;
  5157.     1 : thestyleof := dotted;
  5158.     2 : thestyleof := dashed;
  5159.     3 : thestyleof := dotdash;
  5160.      end;
  5161.    end;
  5162.  
  5163.       
  5164.  
  5165.  
  5166. (* -----!!!!!!!!!!!!  HandleSpecials !!!!!!!!!!!!!------ *)
  5167. begin 
  5168.   tylnam     := 'tyl';
  5169.   beginfigurenam := 'beginfigure';
  5170.   endfigurenam     := 'endfigure';
  5171.   linenam     := 'line';
  5172.   splinenam     := 'spline';
  5173.   ttsplnam     := 'ttspline';
  5174.   beamnam     := 'beam';
  5175.   tieslurnam     := 'tieslur';
  5176.   arcnam     := 'arc';
  5177.   labelnam     := 'label';
  5178.   paramnam     := 'param';
  5179.   usingstream     := true; (* getting bytes from dvifile *)
  5180.  
  5181.   specstart := DVIMark - (specnum - 239 + 1) - 1;
  5182.  
  5183.   ourxpos := h; ourypos := v;  (* note the global DVI (h,v) coords *)
  5184.   i := 1;
  5185.  
  5186.   b := Dget1byte; (* prime the reading scheme *)
  5187.   gotten := (specnum - 239 + 1);
  5188.  
  5189.   while (isaspace(b)) do
  5190.     b := nextpbyte;
  5191.  
  5192.   let := getletter;
  5193.   while (let <> ' ') do (* get the name of the system --- Hopefully 'tyl' *)
  5194.     begin
  5195.     sysnam.str[i] := tolowercase(let);
  5196.     sysnam.len := i;
  5197.     i := i + 1;
  5198.     let := getletter;
  5199.     end;
  5200.  
  5201.    sysnam.str[i] := chr(32); (* end of string *)  
  5202.  
  5203.   if (not streq (sysnam.str, tylnam, 3)) then   (* TeXtyl doesnt know about this special *)
  5204.     begin
  5205.     write (logfile,'The special: ');
  5206.     writestrng(sysnam,true);
  5207.     writeln(logfile,'    is not tyl-able. Skipping...');
  5208.     while (gotten < numpbytes) do
  5209.       b := nextpbyte;
  5210.     goto 888;
  5211.     end;
  5212.  
  5213. (* OTHERWISE: all is okay. Lets look for a primitive to tyl *)
  5214.  
  5215.   while (isdelimiter(b)) do
  5216.     begin
  5217.       b := nextpbyte;
  5218.     end;
  5219.   i := 1;
  5220.   let := getletter; {xchr[b];}
  5221.   while (not (isdelimiter(xord[let]))) do (* get the name of the primitive *)
  5222.     begin
  5223.     nam.str[i] := tolowercase(let);
  5224.     nam.len := i;
  5225.     i := i + 1;
  5226.     let := getletter;
  5227.     end;
  5228.  
  5229.    nam.str[i] := chr(32); (* end of string *)  
  5230.  
  5231.  
  5232.   let := xchr[b];
  5233.  
  5234. (* Now, fill the parse array with bytes so that we can get
  5235.    the given parameters, and infer the defaulted params *)
  5236.  
  5237.   parsmax := min (PARSLEN, ((numpbytes - gotten) + 1));
  5238.  
  5239.   if (parsmax > 1) then
  5240.     begin
  5241.     parsearray[1] := xord[' ']; (* we need this *)
  5242.     parsearray[2] := b;     (* start filling *)
  5243.     for i := 3 to parsmax do
  5244.        begin        (* fill rest *)
  5245.        parsearray[i] := nextpbyte;
  5246.        end;
  5247.     parsposit := 1;
  5248.     usingstream := false; (* now we look at bytes in parse array *)  
  5249.     b := nextpbyte;       (* start it *)
  5250.     end
  5251.   else
  5252.     begin
  5253.     usingstream := true;
  5254.     parsposit := -1; (* undefined *)
  5255.     end;
  5256.  
  5257.                 (* --- BEGINFIGURE ---- *)
  5258.   if streq(nam.str, beginfigurenam, 3) then 
  5259.     begin
  5260.     multifigure := multifigure + 1;
  5261.     i := findscale;
  5262.     SPscale := thescaleof (i);
  5263.  
  5264.     gettransforms (sx100, sy100, rot, transx, transy);
  5265.     (* store all the primitives on pageitems, and dont output
  5266.         them until we get a endfigure. this way, we can take
  5267.         care of dealing with all the primitives according to
  5268.         some global tranformation for the whole figure *)
  5269.       pi := NewItem (Afigure);
  5270.       with pi^ do
  5271.         begin
  5272.         figtheta := rot;
  5273.         fsx := sx100;   fsy := sy100;
  5274.         fdx := round (transx * SPscale);  
  5275.         fdy := round (transy * SPscale);
  5276.         depthnumber := multifigure; (* we're at a new level *)
  5277.     i := findfigdimens;
  5278.     if (i <> EMPTY) then
  5279.       begin
  5280.       preWid := round (getnumber * SPscale);
  5281.       preHt := round (getnumber * SPscale);
  5282.       end;
  5283.     i := findfitsizes;
  5284.     if (i <> EMPTY) then
  5285.       begin
  5286.       postWid := round (getnumber * SPscale);
  5287.       postHt := round (getnumber * SPscale);
  5288.       end;
  5289.         end;  (* with *)
  5290.       BackupInBuf (DVIMark - specstart);
  5291.       pushItem (multifigure - 1, pi);
  5292.       goto 888;
  5293.     end;
  5294.                 (* ---- ENDFIGURE ---- *)
  5295.   if streq(nam.str, endfigurenam, 3) then
  5296.     begin
  5297.     multifigure := multifigure - 1;
  5298.     if (multifigure < 0) then
  5299.       begin
  5300.       complain (ERRBAD);
  5301.       write(logfile,'Warning: Too many "endfigure"s !');
  5302.       multifigure := 0;
  5303.       end;
  5304.     BackupInBuf (DVIMark - specstart);
  5305.  
  5306.     if (multifigure = 0) then
  5307.       begin
  5308.          (* go do our set of figures (within figures...) *)
  5309.       figurehandle (pageitems, pageitems, 1);
  5310.       dispose (pageitems);      (* ### should maybe garbage collect here *)
  5311.       pageitems := nil; 
  5312.       end;  (* if *)
  5313.     goto 888;
  5314.     end;
  5315.  
  5316.                 (* --- LINE  --- *)
  5317.    if streq(nam.str, linenam, 3) then
  5318.      begin              
  5319.      i := findscale;
  5320.      SPscale := thescaleof(i);
  5321.  
  5322.      gettransforms (sx100, sy100, rot, transx, transy);
  5323.      thk := getnumber; (* get the vector thickness *)
  5324.      if (thk < 1) then
  5325.        begin
  5326.        complain (ERRBAD);
  5327.        writeln(logfile,'?? Thickness not found. Setting to 1');
  5328.        thk := 1;
  5329.        end;
  5330.      i := findvectkind;
  5331.      vk := thevectorof (i);
  5332.  
  5333.      i := findlinestyle;
  5334.      if (i <> EMPTY) then
  5335.        patt := thestyleof (getnumber)
  5336.      else
  5337.        patt := solid;
  5338.           
  5339.      x1 := round (getnumber * SPscale);
  5340.      y1 := round (getnumber * SPscale);
  5341.      x2 := round (getnumber * SPscale);
  5342.      y2 := round (getnumber * SPscale);
  5343.  
  5344.      minx := min (x1, x2);
  5345.      maxx := max (x1, x2);
  5346.      miny := min (y1, y2);
  5347.      maxy := max (y1, y2);
  5348.   
  5349.      BackupInBuf (DVIMark - (specstart)); 
  5350.      cmd1byte (OURFONTFLAG);
  5351.      linehandle (multifigure, SPscale, x1, y1, x2, y2, 0, 0, thk, vk, patt,
  5352.                  minx, maxx, miny, maxy,
  5353.                         transx, transy, sx100, sy100, rot);
  5354.    end (* line *)
  5355.                 (* ---- THE SPLINES ---- *)
  5356. else if (streq(nam.str, splinenam, 3) or
  5357.          streq(nam.str, ttsplnam,3)) then
  5358.    begin
  5359.     i := findscale;
  5360.     SPscale := thescaleof (i);
  5361.  
  5362.    gettransforms (sx100, sy100, rot, transx, transy);
  5363.    
  5364.    if streq(nam.str, splinenam, 3) then
  5365.      begin
  5366.      thk := getnumber;
  5367.      if (thk < 1) then
  5368.        begin
  5369.        complain (ERRBAD);
  5370.        writeln(logfile,'Spline Thickness not found. Setting to 1');
  5371.        thk := 1;
  5372.        end;     
  5373.      end;
  5374.      i := findvectkind;
  5375.      vk := thevectorof (i);
  5376.  
  5377.      i := findlinestyle;
  5378.      if (i <> EMPTY) then
  5379.        patt := thestyleof (getnumber)
  5380.      else
  5381.        patt := solid;
  5382.  
  5383.      i := findsplinekind;
  5384.      if (i = xord['b']) then
  5385.        splinetype := BSPL
  5386.      else if (i = xord['i']) then
  5387.        splinetype := INTBSPL
  5388.      else if (i = xord['k']) then
  5389.        splinetype := CATROM
  5390.      else if (i = xord['d']) then
  5391.        splinetype := CARD
  5392.      else if (i = EMPTY) then
  5393.        splinetype := CATROM;
  5394.        
  5395.      i := findsplclosure;
  5396.      if (i = xord['o']) then
  5397.        isclosedspline := true
  5398.      else if (i = xord['u']) then
  5399.        isclosedspline := false
  5400.      else if (i = EMPTY) then
  5401.        isclosedspline := false;
  5402.  
  5403.      i := finddotmark;
  5404.      if (i = xord['x']) then
  5405.        markdiam := getnumber
  5406.      else if (i = EMPTY) then
  5407.        markdiam := 0;
  5408.             
  5409.    numknots := min (getnumber, MAXCTLPTS);
  5410.    if (numknots < 1) then
  5411.      begin
  5412.      complain (ERRBAD);
  5413.      writeln(logfile,'Number of spline/ttspline knot points not found. Setting to 1');
  5414.      numknots := 1;
  5415.      end;
  5416.  
  5417.    minx := TWO24; miny := TWO24;
  5418.    maxx := -TWO24; maxy := -TWO24;
  5419.    
  5420.    for i := 0 to (numknots + 3) do
  5421.      begin
  5422.      cpts[i,1] := 0;
  5423.      cpts[i,2] := 0;
  5424.      end;  (* for *)
  5425.  
  5426.    for i := 1 to numknots do
  5427.      begin
  5428.      x1 := round (getnumber * SPscale);
  5429.      cpts[i,1] := x1;
  5430.      if (x1 < minx) then
  5431.        minx := x1;
  5432.      if (x1 > maxx) then
  5433.        maxx := x1;
  5434.      y1 := round (getnumber * SPscale);
  5435.      cpts[i,2] := y1;
  5436.      if (y1 < miny) then
  5437.        miny := y1;
  5438.      if (y1 > maxy) then
  5439.        maxy := y1;
  5440.      end; (* for *)
  5441.  
  5442.    if streq(nam.str, ttsplnam, 3) then
  5443.      begin
  5444.      for i := 1 to numknots do
  5445.        begin
  5446.        TTary[i] := getnumber;
  5447.        end;
  5448.      end;
  5449.  
  5450.    BackupInBuf (DVIMark - (specstart));
  5451.    cmd1byte (OURFONTFLAG);
  5452.  
  5453.    if streq(nam.str, splinenam, 3) then
  5454.      splinehandle (multifigure, SPscale, splinetype, isclosedspline,
  5455.            markdiam, cpts, numknots, 
  5456.                    0, 0, thk, vk, patt, minx, maxx, miny, maxy, 
  5457.                    transx, transy, sx100, sy100, rot)
  5458.    else
  5459.      ttsplhandle (multifigure, SPscale, splinetype, isclosedspline,
  5460.            markdiam, cpts, TTary, numknots, 
  5461.                    0, 0, vk, patt, minx, maxx, miny, maxy, 
  5462.                    transx, transy, sx100, sy100, rot);
  5463.    end (* splines *)
  5464.                 (* --- BEAMS ---- *)
  5465.  else if streq(nam.str, beamnam, 4) then
  5466.     begin
  5467.     i := findscale;
  5468.     SPscale := thescaleof (i);
  5469.     
  5470.     (* no transforms *)
  5471.  
  5472.     siz := getnumber; (* the staffsize *)
  5473.     i := findbeamkind;
  5474.     if (i = xord['g']) then
  5475.       bk := grace
  5476.     else if (i = xord['r']) then
  5477.       bk := regular
  5478.     else if (i = EMPTY) then
  5479.       bk := regular;
  5480.  
  5481.     x1 := round (getnumber * SPscale);  
  5482.     y1 := round (getnumber * SPscale);
  5483.     x2 := round (getnumber * SPscale);
  5484.     y2 := round (getnumber * SPscale);
  5485.  
  5486.     BackupInBuf (DVIMark - (specstart));
  5487.     cmd1byte (OURFONTFLAG);
  5488.  
  5489.     beamhandle (multifigure, siz, bk, x1, y1, x2, y2);
  5490.     end (* beam *)
  5491.                 (* ---- TIES AND SLURS ---- *)
  5492.   else if streq(nam.str, tieslurnam, 3) then
  5493.     begin
  5494.     i := findscale;
  5495.     SPscale := thescaleof (i);
  5496.  
  5497.      minthk := getnumber;
  5498.      if (minthk < 1) then
  5499.        begin
  5500.        complain (ERRBAD);
  5501.        writeln(logfile,'Tie/Slur Min Thickness not found. Setting to 1');
  5502.        minthk := 1;
  5503.        end;
  5504.    
  5505.      maxthk := getnumber;
  5506.      if (maxthk < 1) then
  5507.        begin
  5508.        complain (ERRBAD);
  5509.        writeln(logfile,'Tie/Slur MaxThickness not found. Setting to 1');
  5510.        maxthk := 1;
  5511.        end;
  5512.  
  5513.      numknots := min (getnumber, MAXCTLPTS);
  5514.      if (numknots < 1) then
  5515.        begin
  5516.        complain (ERRBAD);
  5517.        writeln(logfile,'Tie/Slur Number of knot points not found. Setting to 1. Should be 5');
  5518.        numknots := 1;
  5519.        end;
  5520.      for i := 1 to numknots do
  5521.        begin
  5522.        cpts[i,1] := round (getnumber * SPscale);
  5523.        cpts[i,2] := round (getnumber * SPscale);
  5524.        end;  (* for *)
  5525.     BackupInBuf (DVIMark - (specstart));
  5526.     cmd1byte (OURFONTFLAG);
  5527.  
  5528.     tieslurhandle (multifigure, cpts, numknots, minthk, maxthk);     
  5529.     end (* ties and slurs *)
  5530.     (* --------- ARCS and CIRCLES --------- *)
  5531.   else if streq (nam.str, arcnam, 3) then
  5532.     begin
  5533.     i := findscale;
  5534.     SPscale := thescaleof (i);
  5535.  
  5536.    gettransforms (sx100, sy100, rot, transx, transy);
  5537.    
  5538.    thk := getnumber;
  5539.    if (thk < 1) then
  5540.      begin
  5541.      complain (ERRBAD);
  5542.      writeln(logfile,'Arc Thickness not found. Setting to 1');
  5543.      thk := 1;
  5544.      end;     
  5545.    i := findvectkind;
  5546.    vk := thevectorof (i);
  5547.  
  5548.    i := findlinestyle;
  5549.    if (i <> EMPTY) then
  5550.      patt := thestyleof (getnumber)
  5551.    else
  5552.      patt := solid;
  5553.   
  5554.    radius := round (getnumber * SPscale);
  5555.    if (radius = 0) then
  5556.      radius := round(1 * SPscale);
  5557.    i := findatsign;
  5558.    if (i <> EMPTY) then
  5559.      begin
  5560.      x2 := round (getnumber * SPscale);
  5561.      y2 := round (getnumber * SPscale);
  5562.      end
  5563.    else
  5564.      begin
  5565.      x2 := 0; y2 := 0;  (* assume center at origin *)
  5566.      end; 
  5567.   
  5568.    ang1 := getnumber;
  5569.    if (abs(ang1) > 360) then
  5570.      ang1 := ang1 mod 360;
  5571.    ang2 := getnumber;
  5572.    if (abs(ang2) > 360) then
  5573.      ang2 := ang2 mod 360;
  5574.   
  5575.    minx := TWO24; miny := TWO24;
  5576.    maxx := -TWO24; maxy := -TWO24;
  5577.    
  5578.    if (ang1 = ang2) then
  5579.      begin     (* a circle *)
  5580.        defineCircleCpts (radius,x2,y2, cpts, numknots);
  5581.      end
  5582.    else
  5583.      begin      (* a real arc *)
  5584.      definearcpts (radius, x2,y2, ang1, ang2, cpts, numknots);
  5585.      end;
  5586.   
  5587.    for i := 1 to numknots do
  5588.      begin
  5589.      x1 := cpts[i,1];
  5590.      if (x1 < minx) then
  5591.        minx := x1;
  5592.      if (x1 > maxx) then
  5593.        maxx := x1;
  5594.   
  5595.      y1 := cpts[i,2];
  5596.      if (y1 < miny) then
  5597.        miny := y1;
  5598.      if (y1 > maxy) then
  5599.        maxy := y1;
  5600.      end; (* for *)
  5601.   
  5602.    BackupInBuf (DVIMark - (specstart));
  5603.    cmd1byte (OURFONTFLAG);
  5604.   
  5605.    arccirclehandle (multifigure, SPscale, x2, y2, 
  5606.            radius, ang1, ang2,
  5607.            cpts, numknots, 
  5608.            0, 0, thk, vk, patt, minx, maxx, miny, maxy, 
  5609.            transx, transy, sx100, sy100, rot)
  5610.   
  5611.     end (* arc and circle *)
  5612.     (* ---------- LABELS --------------*)
  5613.   else if streq (nam.str, labelnam, 3) then
  5614.     begin
  5615.     i := findscale;
  5616.     SPscale := thescaleof (i);
  5617.   
  5618.     style := getnumber; (* font style number *)
  5619.     if ((style < 1) or (style > MAXLABELFONTS)) then
  5620.       begin
  5621.       complain (ERRBAD);
  5622.       writeln(logfile,'Label style bad? Setting to Style 1');
  5623.       style := 1;
  5624.       end;
  5625.   
  5626.     x1 := round (getnumber * SPscale);
  5627.     y1 := round (getnumber * SPscale);
  5628.     
  5629.     let := getletter;
  5630.     while (let <> '"') do
  5631.       begin
  5632.       let := getletter;
  5633.       end;
  5634.     i := 0;
  5635.     let := getanything; (* get next letter or whatever *)  
  5636.     while (let <> '"') do
  5637.       begin        (* get the label phrase *)
  5638.       i := i + 1;
  5639.       phrase.str[i] := let;
  5640.       let := getanything; (* getletter;*)
  5641.       end;
  5642.  
  5643.     phrase.str[i+1] := chr(32);
  5644.  
  5645.     phrase.len := i;
  5646.   
  5647.     BackupInBuf (DVIMark - specstart);
  5648.     cmd1byte (OURFONTFLAG);
  5649.     labelhandle (multifigure, SPscale, x1, y1, 0, 0, style, phrase, 0, 0);
  5650.     end (* label *)
  5651.  
  5652.     (* --------- INTERNAL PARAM -------*)
  5653.   else if streq (nam.str, paramnam, 3) then
  5654.     begin
  5655.     i := getnumber; (* addressable param number *)
  5656.  
  5657.       begin
  5658.       writeln (logfile,' I do not know what internal parameter #',i:0,' is');
  5659.       end;  (* else *)
  5660.     BackupInBuf (DVIMark - (specstart));
  5661.     end (* Internal param *)
  5662.   
  5663.       (* ==============  NONE OF THE ABOVE ============== *)
  5664.   else
  5665.     begin       
  5666.     complain (ERRNOTBAD);
  5667.     write (logfile,'Sorry, I don''t know how to tyl ');
  5668.     writestrng (nam,true);
  5669.       
  5670.     while (gotten < numpbytes) do
  5671.       begin
  5672.       b := nextpbyte;
  5673.       end;
  5674.     end;
  5675.   888:
  5676.       (* make sure that we used up all the bytes in this special *)
  5677.   if (gotten < numpbytes) then
  5678.     begin
  5679.     while (gotten < numpbytes) do
  5680.       begin              (* slurp  up  excess *)
  5681.       b := Dgrabbyte;
  5682.       gotten := gotten + 1;
  5683.       end;
  5684.     end;  (* if *)
  5685.   end; (* mainhandlespecials *)
  5686.   
  5687.   
  5688.   (* ==================================================
  5689.   
  5690.   The routines below assume coordinates are already in
  5691.     4th Quadrant DVI-space
  5692.   
  5693.   =====================================================*)
  5694.   
  5695.   
  5696.   
  5697.   {-----------------------------------------------------}
  5698.   (* returns 0 if dy.dx not in font
  5699.       1 if ok
  5700.       2 if ok and caller should use two of the "code"s
  5701.      coding scheme requires  0<= [dx, dy] <= 16
  5702.      AND that max(dx, abs(dy)) is in [0,1,2,4,8,16]
  5703.   *)
  5704. function outvector (dx, dy : integer; var code : integer) : integer;
  5705.   label 99;
  5706.   var c : integer;
  5707.       result : integer;
  5708.   begin
  5709.     if (dx < 0) then
  5710.       begin
  5711.       outvector := 0;
  5712.       goto 99;
  5713.       end;
  5714.       
  5715.     result := 0; (* init for potential failure *)
  5716.     code := (-1);
  5717.     if (dy < 0) then
  5718.       begin
  5719.       c := 160 + dy + dx - 9*max (dx, -dy);
  5720.       end
  5721.     else
  5722.       begin
  5723.       c := 160 + dy - dx - 7*max (dx, dy);
  5724.       end;
  5725.   
  5726.     (* here translate to OUR coding scheme 
  5727.      and return the correct number
  5728.        this is needed because "c" thinks the char range
  5729.        is 0 to 160, while we have only 128 chars *)
  5730.   
  5731.      if (c = 0) then       (* special cases *)
  5732.        begin
  5733.        code := 63; 
  5734.        result := 2;
  5735.        end
  5736.      else if (c = 64) then
  5737.        begin
  5738.        code := 95;
  5739.        result := 2;
  5740.        end
  5741.      else
  5742.        begin       (* regular ones *)
  5743.        result := 1;  (* just one char is fine *)
  5744.        if (c in [1..63]) then
  5745.      code := c - 1
  5746.        else if (c in [80..112]) then
  5747.      code := c - 17
  5748.        else if (c in [120..136]) then
  5749.      code := c - 24
  5750.        else if (c in [140..148]) then
  5751.      code := c - 27
  5752.        else if (c in [150..154]) then
  5753.      code := c - 28
  5754.        else if (c = 160) then
  5755.      code := 127; (* c - 33 *)
  5756.        end;
  5757.   99:
  5758.    outvector := result;
  5759.   end;
  5760.   
  5761.   
  5762.   
  5763.   (* take care of a Manhattan (horizontal /vertical) line *)
  5764.   {----------------------------------------------------------} 
  5765. procedure hvline (lx, by, rx, ty, fontindex : integer);
  5766.   var t, rth, x, y, width, height : integer;
  5767.   begin
  5768.   rth := VFontTable[fontindex]^.PenSize; (* thickness of vector in sp *)
  5769.   if (lx = rx) then
  5770.     begin              (* Vertical line *)
  5771.     if (ty > by) then       
  5772.       begin
  5773.       t := by; by := ty; ty := t;  (* swap *)
  5774.       end;
  5775.     x := round (lx - (rth / 2.0));
  5776.     y := by;
  5777.     width := rth;
  5778.     height := by - ty;
  5779.     end
  5780.   else
  5781.     begin              (* Horizontal line *)
  5782.     if (ty < by) then
  5783.       begin
  5784.       t := by; by := ty; ty := t;  (* swap *)
  5785.       end;
  5786.     if (lx > rx) then
  5787.       begin
  5788.       t := lx; lx := rx; rx := t; (* swap *)
  5789.       end;
  5790.     x := lx;
  5791.   
  5792.     y := (by + (rth div 2)); (* + rth for {h,v}-space *)
  5793.     width := rx - lx;
  5794.     height := rth;
  5795.     end;
  5796.   
  5797.   isetpos (x, y);
  5798.   cmd1byte (PUTRULE);
  5799.   cmd4byte (height);
  5800.   cmd4byte (width);
  5801.   
  5802.   (* output two dots on ends of the rules
  5803.    at    lx, by  and rx, ty  *)
  5804.   (* the font has already been set before these calls *)
  5805.   Tyldot (lx, by);
  5806.   Tyldot (rx, ty);
  5807.   isetpos (rx, ty);
  5808.   end;
  5809.   
  5810.   
  5811.   {------------------------------------------------------------}
  5812. procedure diagonal (xl, yb, xr, yt : ScaledPts; fontindex: integer);
  5813.   var t, curx, cury, dx, dy, code : integer;
  5814.       slope : real;
  5815.       mxveclen : ScaledPts;
  5816.       sptovecs : real;
  5817.       rho : ScaledPts;
  5818.   
  5819.       {......................................}
  5820.       (* compute maximum length vector character that we  can use *)
  5821.   
  5822.       procedure  getincr (var outdx, outdy : integer);
  5823.       label 99;
  5824.        var radius, x, y : integer;
  5825.        sign : integer;
  5826.        q : real;
  5827.   
  5828.        begin  (* getincr *)
  5829.        radius := mxveclen;   (* radius of semi-square *)
  5830.        (* make sure the pt is outside of the semi-square,
  5831.       scaling down radius if necessary *)
  5832.        while ( ((xr - curx) < radius) and
  5833.           (abs (yt - cury) < radius)) do
  5834.      begin
  5835.      radius := radius div 2;
  5836.      end;
  5837.        if (slope < 0.0) then  (* <0 since in 4th quad by now*)
  5838.      sign := -1
  5839.        else
  5840.      sign := +1;
  5841.        if (xr = curx) then
  5842.      begin
  5843.      outdx := 0;
  5844.      outdy := sign * radius;
  5845.      goto 99;
  5846.      end;
  5847.        if (yt = cury) then
  5848.      begin
  5849.      outdx := abs (radius);
  5850.      outdy := 0;
  5851.      goto 99;
  5852.      end;
  5853.   
  5854.        (* compute the intersection with the semi-square,
  5855.       choose whichever slope is best *)
  5856.        if (abs (slope) < 1.0) then
  5857.      begin              (* mostly horizontal *)
  5858.      outdx := abs (radius);
  5859.      y := yb + round ((curx + abs(radius) - xl) * slope); 
  5860.      outdy := y - cury;
  5861.      end
  5862.        else
  5863.      begin              (* mostly vertical *)
  5864.      x := xl + round ((cury + (sign * radius) - yb) / slope); 
  5865.      outdx := x - curx;
  5866.      outdy := sign * radius;
  5867.      end;
  5868.   
  5869.        if (abs (outdy) > abs (yt - cury)) then
  5870.      begin         (* truncate *)
  5871.      outdy := yt - cury;
  5872.      end;
  5873.        if (outdx > (xr - curx)) then
  5874.      begin         (* truncate *)
  5875.      outdx := xr - curx;
  5876.      end;
  5877.        if (outdx < 0) then
  5878.      begin
  5879.      outdx := 0;
  5880.      end;
  5881.   
  5882.        (* method to find the exact intersection of the line segment
  5883.     with the semi-circle, used
  5884.     to determine the x and y values::
  5885.     we do this by using the arctangent of the slope as
  5886.     the angle 'a' from the x-axis. Then use the relation
  5887.      y = r cos a, and x = r sin a
  5888.     we can be smart about all this trig stuff by using
  5889.     the relation :
  5890.         sin (arctan a) = 1/sqrt(1 + a^2)
  5891.         cos (arctan a) = a/sqrt(1 + a^2)
  5892.     Thus:
  5893.     q := (1.0 / sqrt (slope * slope + 1.0));
  5894.     outdx := round (q * radius);
  5895.     outdy := round (q * radius * slope);
  5896.   
  5897.     Unfortunately, we cannot access the Vector Font
  5898.     coding scheme because the outdx, outdy 's produced
  5899.     here do no conform to the condition
  5900.         max (dx, abs(dy)) in [0,1,2,4,8,16]
  5901.     when converted to vector-font sizes with 
  5902.     sptovecs (see  the 'diagonal' proc.).
  5903.     *)
  5904.   
  5905.   99:
  5906.        end; (* getincr *)
  5907.     {.......................................}
  5908.   
  5909.   begin (* DIAGONAL *)
  5910.   if (xr <> xl) then
  5911.     slope := (yt - yb) / (xr - xl)
  5912.   else
  5913.     slope := BIGREAL; (* some illegal value *)
  5914.   
  5915.   if (xl > xr) then
  5916.     begin
  5917.     t := xl; xl := xr; xr := t;
  5918.     t := yb; yb := yt; yt := t;
  5919.     end; (* swap *)
  5920.     
  5921.   curx := xl;
  5922.   cury := yb;
  5923.   mxveclen :=  (VFontTable[fontindex]^.MaxVectLen); 
  5924.   rho := mxveclen div 16;  (* minimum radius of vector fonts *)
  5925.   if (rho = 0) then
  5926.     begin
  5927.     complain (ERRREALBAD);
  5928.     writeln(logfile,'Diagonal: Min radius of vector font is zero. setting to 1');
  5929.     rho := 1;
  5930.     end;
  5931.   
  5932.   if ((abs(xl - xr) <= rho) and
  5933.       (abs(yb - yt) <= rho)) then
  5934.     begin    (* pretty much a null line *)
  5935.       Tyldot (xl, yb);
  5936.     end
  5937.   else
  5938.     begin
  5939.     sptovecs := 1.0 / rho; (* conversion for scaled pts to vectorfont units *)
  5940.   
  5941.     code := -1; (* initialize to a bogus number *)
  5942.   
  5943.     (* this conditional really has to have "or"
  5944.         instead of "and", because of lines that are
  5945.         *nearly*  horizontal or vertical
  5946.     *)
  5947.     while (((xr - curx) >= rho) or (abs(yt - cury) >= rho)) do  
  5948.       begin
  5949.   (* Get the approximate incremental amount. We use this dy/dx
  5950.     pair in order to index into our vector font coding scheme *)
  5951.   
  5952.       getincr (dx, dy);
  5953.   
  5954.   (* Get the vector character code corresponding to this 
  5955.     approximate incremental amount *)
  5956.       t := outvector (round (dx * sptovecs), 
  5957.               round (dy * sptovecs), 
  5958.               code);
  5959.   (* Now that we have the character code, go find out its actual
  5960.     physical dimensions for the real dy/dx amounts *)
  5961.       if (dy > 0) then
  5962.      dy := VFontTable[fontindex]^.FontInfo[code].Cdp
  5963.       else
  5964.      dy := -(VFontTable[fontindex]^.FontInfo[code].Cht);
  5965.   
  5966.       dx := VFontTable[fontindex]^.FontInfo[code].Cwd;
  5967.     
  5968.       case (t) of
  5969.        0: begin
  5970.         complain (ERRREALBAD);
  5971.         writeln (logfile,'Error in Diagonal:: bad dydx');
  5972.       end;
  5973.       
  5974.        1: begin
  5975.         isetpos (curx, cury);
  5976.         iputchar (code);
  5977.       end;
  5978.           
  5979.        2: begin
  5980.         isetpos (curx, cury);
  5981.         iputchar (code);
  5982.         isetpos (curx + (dx div 2),  cury + (dy div 2));
  5983.         iputchar (code);
  5984.       end;
  5985.       end; (* case *)
  5986.   
  5987.       curx := curx + dx;
  5988.       cury := cury + dy;
  5989.       end; (* while *)
  5990.   
  5991.     if ((code >= 0) and
  5992.      (((xr - curx) >= rho) and (abs(yt - cury) >= rho))) then
  5993.       begin
  5994.       iputchar (code);
  5995.       end;
  5996.     end;   (* not null line *)
  5997.   end;
  5998.  
  5999.  
  6000. {-------------------------------------------------------}
  6001. procedure tylBrokenLine (x0, y0, x1, y1, fontindex : integer;
  6002.              line_type: LineStyle);
  6003. label 10;
  6004. var useXaxis: boolean;
  6005.     a0, b0, a1, b1: integer;
  6006.     a2, a3, b2, b3, K, gap, dot, dash: integer; 
  6007.     s, z, fit: real;
  6008.     J, frame, T: integer;
  6009.     Dotgap, Dotdot:  integer;
  6010.     Dashgap, Dashdash: integer;
  6011.     DDotgap, DDotdot, DDotdash: integer;    
  6012.     a1ma0 : integer;
  6013.     
  6014. {.........................................................}
  6015.    procedure spread (lt : LineStyle; extra, T : integer);
  6016.       label 20;
  6017.       begin
  6018.       if (T = 0) then
  6019.          begin  { only partial frame fits }
  6020.          if (useXaxis) then 
  6021.        diagonal (a0, b0, a1, b1, fontindex)
  6022.          else 
  6023.        diagonal (b0, a0, b1, a1, fontindex);
  6024.          goto 20;  { exit }
  6025.          end;
  6026.       J := 0;
  6027.       s := float (b1 - b0)/float(a1 - a0);
  6028.       z := float (extra)/float(T);
  6029.       case lt of
  6030.          dotted : repeat a2 := a0 + J*frame;
  6031.                          if (extra > 0) then a2 := a2 + round(J*z);
  6032.                          a3 := a2 + dot;
  6033.                          b2 := round(s*(a2-a0) + b0);
  6034.                          b3 := round(s*(a3-a0) + b0);
  6035.                          if (a3 <= a1) then
  6036.                             begin
  6037.                             if (useXaxis) then
  6038.                   diagonal (a2, b2, a3, b3, fontindex)
  6039.                             else  
  6040.                   diagonal (b2, a2, b3, a3, fontindex);
  6041.                             end;
  6042.                          J := J + 1;
  6043.                      until (a3 >= a1);
  6044.          dashed : repeat a2 := a0 + J*frame;
  6045.                          if (extra > 0) then a2 := a2 + round(J*z);
  6046.                          a3 := a2 + dash;
  6047.                          b2 := round(s*(a2-a0) + b0);
  6048.                          b3 := round(s*(a3-a0) + b0);
  6049.                          if (a3 <= a1) then
  6050.                            begin
  6051.                            if (useXaxis) then
  6052.                  diagonal (a2, b2, a3, b3, fontindex)
  6053.                            else
  6054.                  diagonal (b2, a2, b3, a3, fontindex);
  6055.                            end;
  6056.                          J := J + 1;
  6057.                      until (a3 >= a1);
  6058.         dotdash : repeat a2 := a0 + J*frame;
  6059.                          if (extra > 0) then a2 := a2 + round(J*z);
  6060.                          a3 := a2 + dash;
  6061.                          b2 := round(s*(a2-a0) + b0);
  6062.                          b3 := round(s*(a3-a0) + b0);
  6063.                          if (a3 <= a1) then
  6064.                             begin
  6065.                             if (useXaxis) then
  6066.                   diagonal (a2, b2, a3, b3, fontindex)
  6067.                             else
  6068.                   diagonal (b2, a2, b3, a3, fontindex);
  6069.                             a2 := a3 + gap;
  6070.                             if (extra > 0) then a2 := a2 + round(z*0.5);
  6071.                             a3 := a2 + dot;
  6072.                             b2 := round(s*(a2-a0) + b0);
  6073.                             b3 := round(s*(a3-a0) + b0);
  6074.                             if (a3 <= a1) then
  6075.                                begin
  6076.                                if (useXaxis) then
  6077.                      diagonal (a2, b2, a3, b3, fontindex)
  6078.                                else
  6079.                      diagonal (b2, a2, b3, a3, fontindex);
  6080.                                end;
  6081.                             end;
  6082.                          J := J + 1;
  6083.                      until (a3 >= a1);
  6084.          end;
  6085.      20:
  6086.       end;   { spread }
  6087.       
  6088. {......................................................}               
  6089.    procedure balance (lt : LineStyle; extra, T : integer);
  6090.       label 30;
  6091.       begin
  6092.       if (T = 0) then
  6093.          begin  { only partial frame fits }
  6094.          if (useXaxis) then
  6095.         diagonal (a0, b0, a1, b1, fontindex)
  6096.          else
  6097.         diagonal (b0, a0, b1, a1, fontindex);
  6098.          goto 30; { exit }
  6099.          end;
  6100.       J := 0;
  6101.       s := float(b1 - b0)/float(a1 - a0);
  6102.       case lt of
  6103.          dashed : repeat a2 := a0 + J*frame - extra div 2;
  6104.                          a3 := a2 + dash;
  6105.                          if (J = 0) then a2 := a0;
  6106.                          if (a3 > a1) then a3 := a1;
  6107.                          b2 := round(s*(a2-a0) + b0);
  6108.                          b3 := round(s*(a3-a0) + b0);
  6109.                          if (a3 <= a1) then
  6110.                            begin
  6111.                            if (useXaxis) then
  6112.                  diagonal (a2, b2, a3, b3, fontindex)
  6113.                            else
  6114.                  diagonal (b2, a2, b3, a3, fontindex);
  6115.                            end;
  6116.                          J := J + 1;
  6117.                      until (a3 >= a1);
  6118.         dotdash : repeat a2 := a0 + J*frame - extra div 2;
  6119.                          a3 := a2 + dash;
  6120.                          if (J = 0) then a2 := a0;
  6121.                          if (a3 > a1) then a3 := a1;
  6122.                          b2 := round(s*(a2-a0) + b0);
  6123.                          b3 := round(s*(a3-a0) + b0);
  6124.                          if (a3 <= a1) then
  6125.                             begin
  6126.                             if (useXaxis) then
  6127.                   diagonal (a2, b2, a3, b3, fontindex)
  6128.                             else 
  6129.                   diagonal (b2, a2, b3, a3, fontindex);
  6130.                             a2 := a3 + gap;
  6131.                             a3 := a2 + dot;
  6132.                             b2 := round(s*(a2-a0) + b0);
  6133.                             b3 := round(s*(a3-a0) + b0);
  6134.                             if (a3 <= a1) then
  6135.                                begin
  6136.                                if (useXaxis) then
  6137.                      diagonal (a2, b2, a3, b3, fontindex)
  6138.                                else
  6139.                      diagonal (b2, a2, b3, a3, fontindex);
  6140.                                end;
  6141.                             end;
  6142.                          J := J + 1;
  6143.                      until (a3 >= a1);
  6144.          end;
  6145.      30:
  6146.       end;  { balance }
  6147.       
  6148. {......................................................}   
  6149.   function project (I : integer) : integer;
  6150.     var K : integer;        { gives the projection of lengths onto axes }
  6151.     begin
  6152.     K := round(I*float(abs(a1-a0))/s);
  6153.     if K = 0 then K := 1;
  6154.     project := K;
  6155.     end;
  6156. {......................................................}
  6157.   procedure setlengths (findex :integer);
  6158.         (*  sets the "optimal" sizes for textured lines *)
  6159.     var penrad : integer;
  6160.         siz : VThickness;
  6161.     begin
  6162.     penrad := VFontTable[findex]^.PenSize;
  6163.     siz := VFontTable[findex]^.psize;
  6164.  
  6165.     Dotdot  :=  penrad div siz;   Dotgap := 6 * penrad;
  6166.     Dashdash := 6 * penrad;  Dashgap := 6 * penrad;
  6167.     DDotdash := 6 * penrad;  DDotgap := 4 * penrad; 
  6168.     DDotdot :=  penrad div siz;
  6169.     end;
  6170. {........................................}
  6171. procedure setframesize;
  6172. begin
  6173.  case line_type of        { length of frame depends on type of broken line }
  6174.     solid   : frame := 0;
  6175.     dotted  : frame := gap + dot;
  6176.     dashed  : frame := gap + dash;
  6177.     dotdash : frame := 2*gap + dot + dash;
  6178.     end;
  6179. end;
  6180.  
  6181. {.................................................}         
  6182. begin  (*  TylBrokenLine *)
  6183. if ((x0 = x1) and (y0 = y1)) then
  6184.   begin
  6185.   diagonal (x0, y0, x1, y1, fontindex); { null line }
  6186.   goto 10;
  6187.   end;
  6188.  
  6189.   setlengths (fontindex);
  6190.  
  6191. if (abs (y1-y0) > abs(x1-x0)) then    { longer axis is used as base }
  6192.   begin
  6193.   useXaxis := false;
  6194.   a0 := y0;  b0 := x0;
  6195.   a1 := y1;  b1 := x1;
  6196.   end
  6197. else
  6198.   begin
  6199.   useXaxis := true;
  6200.   a0 := x0;  b0 := y0;
  6201.   a1 := x1;  b1 := y1;
  6202.   end;
  6203. { the distance between a0 and a1 is now greater than that between b0 and b1. }
  6204.  
  6205. { redefine distances as integral units along axes }
  6206.  s := distance (float(a0),float(b0),float(a1),float(b1));
  6207.  
  6208.  case line_type of
  6209.    solid: ;
  6210.    dotted:
  6211.      begin
  6212.      gap := project(Dotgap);
  6213.      dot := project(Dotdot);
  6214.      end;
  6215.    dashed:
  6216.      begin
  6217.      gap := project(Dashgap);
  6218.      dash := project(Dashdash);
  6219.      end;
  6220.    dotdash:
  6221.      begin
  6222.      gap := project(DDotgap);
  6223.      dot := project(DDotdot);
  6224.      dash := project(DDotdash);
  6225.      end;
  6226.    end;
  6227.  
  6228.              { ensure direction of line is from smaller to
  6229.                larger along the longer axis }
  6230.  if (a0 > a1) then     
  6231.     begin
  6232.     J := a0; a0 := a1; a1 := J;
  6233.     J := b0; b0 := b1; b1 := J;
  6234.     end;
  6235.     
  6236.  setframesize; 
  6237.  
  6238.  a1ma0 := a1 - a0;
  6239.  
  6240.     { fit is the number of frames that fit in line }
  6241.  if (frame <> 0) then
  6242.    begin
  6243.    fit := (float(a1ma0) / float(frame));
  6244.    end
  6245.  else
  6246.    fit := 1.0;
  6247.  
  6248.  if (fit >= 1.0) then
  6249.    T := round (fit)
  6250.  else
  6251.    begin
  6252.   (* change frame elements (dot, dash, gap) since frame is too large *)
  6253.      case line_type of
  6254.        dotted : begin
  6255.                gap := gap - (frame - a1ma0);
  6256.         if (gap < dot) then 
  6257.           begin
  6258.           goto 10; (* exit *)
  6259.           end;
  6260.         setframesize;
  6261.         end;
  6262.  
  6263.     dashed,
  6264.     dotdash : begin
  6265.     (* idea:decrease gap; if too small then shrink dash and refigure gap*)
  6266.          if ((frame - a1ma0) > (gap div 2)) then
  6267.            begin
  6268.            dash := round (dash * fit * 0.80);
  6269.            gap := round (gap * fit);
  6270.            setframesize;
  6271.            end;
  6272.          gap := gap - (frame - a1ma0);
  6273.          if (line_type = dotdash) then
  6274.            gap := gap div 2;
  6275.          if (gap < dot) then 
  6276.            begin
  6277.            goto 10; (* exit *)
  6278.            end;
  6279.          setframesize;
  6280.          end;
  6281.     end; (* case *)
  6282.      T := 1; (* NOW it will fit *)
  6283.    end;  (* else *)
  6284.  
  6285.  
  6286.  case line_type of
  6287.     solid : begin
  6288.           if (useXaxis) then
  6289.             diagonal (a0, b0, a1, b1, fontindex)
  6290.           else 
  6291.                 diagonal (b0, a0, b1, a1, fontindex);
  6292.         end;
  6293.  
  6294.     dotted : begin         { dotted lines begin and end on a dot }
  6295.          if ((T*frame + dot) = a1ma0) then
  6296.         spread(dotted, 0, T) 
  6297.          else if ((T*frame + dot) > a1ma0) then
  6298.              begin
  6299. {        gap := gap - ((T*frame+dot)-a1ma0);
  6300. {}
  6301.             spread(dotted, a1ma0 - T*frame - dot, T);
  6302.  
  6303. {              spread(dotted, a1ma0 - (T-1)*frame - dot, T-1);
  6304. {}
  6305.         end
  6306.          else 
  6307.            spread(dotted, a1ma0 - T*frame - dot, T);
  6308.          end;
  6309.  
  6310.     dashed : begin
  6311.                { dashed lines begin and end on dash :
  6312.             the beginning and ending dashes are at least half
  6313.             the dash length long. }
  6314.           if ((T*frame + dash) = a1ma0) then 
  6315.         spread(dashed, 0, T)
  6316.          else if ((T*frame + dash) > a1ma0) then
  6317.         balance(dashed, T*frame + dash - a1ma0, T)
  6318.          else spread(dashed, a1ma0 - T*frame - dash, T);
  6319.          end;
  6320.  
  6321.     dotdash : begin        { if ending on a dash then beginning and ending
  6322.             dashes are half the dash length long - final
  6323.             dots are full dot length }
  6324.           if ((T*frame + dash) = a1ma0) then
  6325.          spread(dotdash, 0, T)
  6326.           else if ((T*frame + dash + gap + dot) = a1ma0) then
  6327.          spread(dotdash, 0, T)
  6328.           else if ((T*frame + dash) > a1ma0) then
  6329.          balance(dotdash, T*frame + dash - a1ma0, T)
  6330.           else if ((T*frame + dash + gap + dot) > a1ma0) then
  6331.          spread(dotdash, a1ma0 - T*frame - dash, T)
  6332.           else spread(dotdash, a1ma0 - T*frame - dash - gap - dot, T);
  6333.           end;
  6334.     end;
  6335. 10:
  6336.  end;
  6337.  
  6338.     
  6339.  
  6340. {-------------------------------------------------------}
  6341. procedure clampthickness (var thic : VThickness);
  6342.   begin
  6343.   (* #### this is just a simple clamp
  6344.     really should be something like:
  6345.     while not (thic in set_of_appropriate_thicknesses) do
  6346.       modify thic and try again
  6347.   *)
  6348.   if (thic <= LoVThick ) then
  6349.     thic := LoVThick + 1;
  6350.   while ((not (thic in [1,2,3,4,5,6,7,8,9,10,11,12])) and
  6351.       (thic <= HiVThick)) do
  6352.     thic := thic + 1;
  6353.   
  6354.   if (thic >  HiVThick) then
  6355.     thic := HiVThick;
  6356.   end;
  6357.   
  6358. {----------------------------------------------------------}
  6359. procedure slurclamp (var thic : ThickAryType; totpts : integer);
  6360.   (* this post-clamps the sampled thicknesses calculated over the
  6361.   whole of the spline *)
  6362.   
  6363.   var i : integer;
  6364.    oneseventh : integer;
  6365.    middle : integer;
  6366.    startval, endval: integer;
  6367.    deltaval, val, incrval, alpha, alphaincr: real;
  6368.    
  6369.   begin 
  6370.   { $$ NOTE:: How does the ttspline interpolation of thicknesses
  6371.   compare to the below results?? Can we avoid having it done
  6372.   elsewhere and concentrate on it here?? }
  6373.   
  6374.   oneseventh := round (totpts / 7.0);
  6375.   for i := 1 to oneseventh do
  6376.     begin
  6377.     thic[i] := thic[1];
  6378.     end;
  6379.   for i := 6*oneseventh to totpts do
  6380.     begin
  6381.     thic[i] := thic[totpts];
  6382.     end;  
  6383.   
  6384.   middle := round (totpts / 2.0);
  6385.   for i := 3*oneseventh to 4*oneseventh do
  6386.     begin
  6387.     thic[i] := thic[middle];
  6388.     end;
  6389.   
  6390.   startval := thic[oneseventh - 1];
  6391.   endval := thic[3*oneseventh + 1];
  6392.   deltaval := (2*(endval - startval))/(2*oneseventh);
  6393.   alphaincr := PI / (2 * oneseventh + 1);
  6394.   alpha := PI;
  6395.   val := float(startval);
  6396.   for i := oneseventh to (3*oneseventh - 1) do
  6397.     begin     (* interpolate: ease in from minthick to middlethickness *)
  6398.     alpha := alpha + alphaincr;
  6399.     incrval := ((cos (alpha) + 1.0) / 2.0) * deltaval;
  6400.     val := val + incrval;
  6401.     thic[i] := round(val);
  6402.     end;
  6403.   
  6404.   startval := thic[4*oneseventh - 1];
  6405.   endval := thic[6*oneseventh + 1];
  6406.   deltaval := (2*(endval - startval))/(2*oneseventh);
  6407.   alphaincr := PI / (2 * oneseventh + 1);
  6408.   alpha := 0.0;
  6409.   val := float(startval);
  6410.   for i := (4*oneseventh + 1) to 6*oneseventh do
  6411.     begin  (* ease out from middle thickness to min thick at far end *)
  6412.     alpha := alpha + alphaincr;
  6413.     incrval := ((cos (alpha) + 1.0) / 2.0) * deltaval;
  6414.     val := val + incrval;
  6415.     thic[i] := round(val);
  6416.     end;
  6417.   end;
  6418.   
  6419. {-------------------------------------------------------}
  6420. procedure layline (xl, yb, xr, yt, fontindex : integer; 
  6421.            pattern : LineStyle; useVecfontOnly : boolean);
  6422.   var t: integer;  
  6423.   begin
  6424.   if (xr < xl) then
  6425.     begin
  6426.     t := xr; xr := xl; xl := t;
  6427.     t := yb; yb := yt; yt := t;
  6428.     end;
  6429.   
  6430.   isetfont (VFontTable[fontindex]^.DVIFontNum);
  6431.   
  6432.   (* we may want to require using a vector font only,
  6433.   instead of a combination of vectors and TeX-rules.
  6434.   It may look better this way.
  6435.   *)  
  6436.     if (useVecfontOnly) then
  6437.        begin
  6438.        tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
  6439.        end
  6440.     else
  6441.       begin (* be smart about the lines *)
  6442.       if ((xl = xr) and (yb = yt)) or
  6443.       ((xl <> xr) and (yb <> yt)) then    (* Null or diagonal lines *)
  6444.       begin
  6445.       if (pattern = solid) then
  6446.           diagonal (xl, yb, xr, yt, fontindex)
  6447.       else
  6448.         tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
  6449.       end
  6450.       else
  6451.          begin
  6452. {     if (pattern = solid) then
  6453.        hvline (xl, yb, xr, yt, fontindex) (* make use of rules *)
  6454.      else
  6455. USENORULES }
  6456.        tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
  6457.      end
  6458.       end;
  6459.     
  6460.   end;
  6461.   
  6462.   
  6463.   
  6464. {------------------------------------------------------}
  6465. procedure layAspline (thetype : SplineKind; 
  6466.               isclosed : boolean;
  6467.               isanArc: boolean;
  6468.               domarks : integer;
  6469.               var cpts : ControlPoints;
  6470.               numpts : integer;
  6471.               thick: VThickness;
  6472.               vkind : VectKind;
  6473.               patt : LineStyle);
  6474.   const DontDoThicks = false;
  6475.     VectorsOnly = true;
  6476.   var pointList: SplineSegments;
  6477.     i, xs, ys : integer;
  6478.     tt1, tt2 : ThickAryType;
  6479.     F: VecIndex;
  6480.   begin
  6481.   
  6482.   clampthickness (thick);  
  6483.   for i := 0 to (numpts + 3) do
  6484.     tt1[i] := thick;
  6485.   
  6486.   (*  do any marks if necessary to show the control points *)
  6487.   if (domarks > 0) then
  6488.     begin
  6489.     F := GetVectFont (domarks, VKCirc);
  6490.     isetfont (VFontTable[F]^.DVIFontNum);
  6491.     for i := 1 to numpts do
  6492.       begin
  6493.       Tyldot (cpts[i,1], cpts[i,2]);
  6494.       end;  
  6495.     end;  
  6496.   
  6497.   drawSpline (thetype, isclosed, isanArc, patt,
  6498.          numpts, cpts, pointList, DontDoThicks, tt1, tt2);
  6499.   
  6500.   
  6501.   F := GetVectFont (thick, vkind);
  6502.   xs := pointList[1, 1];
  6503.   ys := pointList[1, 2];
  6504.   
  6505.   for i := 2 to lastPoint do
  6506.     begin
  6507.     layline (xs, ys, pointList[i, 1], pointList[i, 2], F, patt, VectorsOnly);
  6508.     xs := pointList[i, 1];
  6509.     ys := pointList[i, 2];
  6510.     end;
  6511.   if (isclosed) then (* complete the motion *)
  6512.     layline (pointList[lastPoint,1], pointList[lastPoint,2],
  6513.          pointList[1,1], pointList[1,2], F, patt, VectorsOnly);
  6514.   end;
  6515.   
  6516.  
  6517. {-----------------------------------------------------}
  6518. procedure layNspline (thetype : SplineKind; 
  6519.             isclosed : boolean;
  6520.             isitaslur : boolean; 
  6521.             domarks : integer;
  6522.             var cpts : ControlPoints;
  6523.             numpts : integer;
  6524.             var thickmatrix : ThickAryType;
  6525.             vkind : VectKind;
  6526.             patt : LineStyle);
  6527.   const NotAnArc = false;
  6528.     DoThicksToo = true;
  6529.     VectorsOnly = true;
  6530.   var pointList: SplineSegments;
  6531.     i, xs, ys : integer;
  6532.     ts : VThickness;
  6533.     tt : ThickAryType;
  6534.     F : VecIndex;
  6535.   begin
  6536.   (*  do any marks if necessary to show the control points *)
  6537.   if (domarks > 0) then
  6538.     begin
  6539.     F := GetVectFont (domarks, VKCirc);
  6540.     isetfont (VFontTable[F]^.DVIFontNum);
  6541.     for i := 1 to numpts do
  6542.       begin
  6543.       Tyldot (cpts[i,1], cpts[i,2]);
  6544.       end;  
  6545.     end;  
  6546.   
  6547.   drawSpline (thetype, isclosed, NotAnArc, patt,
  6548.         numpts, cpts, pointList,
  6549.         DoThicksToo, thickmatrix, tt);
  6550.   if ((isitaslur) and (not skiptsclamp))  then
  6551.     begin
  6552.     slurclamp(tt, lastPoint);  (* which kind of clamping to use *)
  6553.     end;
  6554.   
  6555.   xs := pointList[1, 1];
  6556.   ys := pointList[1, 2];
  6557.   ts := tt[1];
  6558.   
  6559.   for i := 2 to lastPoint do
  6560.     begin
  6561.     clampthickness (ts);
  6562.     F := GetVectFont (ts, vkind);
  6563.     layline (xs, ys, pointList[i, 1], pointList[i, 2], F, patt, VectorsOnly);
  6564.     xs := pointList[i, 1];
  6565.     ys := pointList[i, 2];
  6566.     ts := tt[i];
  6567.     end;
  6568.   if (isclosed) then
  6569.     begin
  6570.     ts := tt[lastPoint];
  6571.     clampthickness(ts);
  6572.     F := GetVectFont (ts, vkind);
  6573.     layline (pointList[lastPoint,1], pointList[lastPoint,2],
  6574.          pointList[1,1], pointList[1,2], F, patt, VectorsOnly);
  6575.     end;
  6576.   end;
  6577.   
  6578.   
  6579.   
  6580. {-----------------------------------------------------}    
  6581. procedure TylBeam (* fromx, fromy, tox, toy: ScaledPts;
  6582.            staffsize : integer; kind : BeamKind *); 
  6583.  
  6584.   begin
  6585.  
  6586.   end; (* TylBeam *)
  6587.   
  6588.   
  6589. {-------------------------------------------------------}
  6590. procedure TylLine (* xl, yb, xr, yt: ScaledPoints;
  6591.             thickness: VThickness;
  6592.             vec: VectKind; patt : LineStyle *);
  6593.   const dontCare = false;
  6594.   var findex: VecIndex;
  6595.   begin
  6596.   clampthickness (thickness);
  6597.   findex := GetVectFont (thickness, vec);
  6598.   layline (xl, yb, xr, yt, findex, patt, dontCare);
  6599.   end;
  6600.   
  6601.   
  6602. {-----------------------------------------------------}
  6603. procedure TylThickThinSpline (* thetype : SplineKind; isclosed : boolean;
  6604.               var KnotArray: ControlPoints; 
  6605.               var ThikThinAry: ThickAryType;
  6606.               numknots: integer;
  6607.               vec: VectKind;
  6608.               patt : LineStyle; domarks : integer *);
  6609.   const NotAnArc = false;
  6610.   begin 
  6611.   layNspline (thetype, isclosed, NotAnArc, domarks, KnotArray, numknots, 
  6612.         ThikThinAry, vec, patt);
  6613.   end;
  6614.   
  6615. {----------------------------------------------------}
  6616. procedure TylSpline (* thetype : SplineKind; isclosed : boolean;
  6617.          var KnotArray: ControlPoints; numknots: integer;
  6618.          thick: VThickness; vec: VectKind; patt : LineStyle; domarks : integer*);
  6619.   const NotAnArc = false;
  6620.   begin
  6621.    layAspline (thetype, isclosed, NotAnArc, domarks, KnotArray, numknots, 
  6622.         thick, vec, patt);
  6623.   end;
  6624.   
  6625. {-----------------------------------------------------}
  6626. procedure TylTieSlur (* KnotArray: ControlPoints; 
  6627.               numknots: integer;
  6628.               minthick, maxthick: VThickness *);
  6629.   const ItsASlur = true;
  6630.       NotClosed = false;
  6631.   var ourttarray : ThickAryType;
  6632.     one7th : real;
  6633.     val : VThickness;
  6634.   begin
  6635.   
  6636.   clampthickness (minthick);
  6637.   clampthickness (maxthick);
  6638.   if (numknots <> 5) then
  6639.       writeln ('TieSlur needs 5 control points ');
  6640.   one7th := 1.0/7.0;
  6641.   val := round (one7th * (maxthick - minthick));
  6642.   ourttarray[1] := minthick;
  6643.   ourttarray[2] := minthick + val;
  6644.   ourttarray[3] := maxthick;
  6645.   ourttarray[4] := minthick + val;    
  6646.   ourttarray[5] := minthick;
  6647.   
  6648.   layNspline (CATROM, NotClosed, ItsASlur, 0, KnotArray, numknots, ourttarray, 
  6649.           VKCirc, solid);
  6650.   end;
  6651.   
  6652.   
  6653. {-------------------------------------------------------}
  6654. procedure doTylArc (* iscircle : boolean;
  6655.             var apts : ControlPoints;
  6656.             numknots : integer; 
  6657.             thick : VThickness; 
  6658.             vec : VectKind;
  6659.             patt : LineStyle *);
  6660.   
  6661.   const ItsAnArc = true;
  6662.   begin
  6663.   
  6664.   layAspline (BSPL, iscircle, ItsAnArc, 0, apts, numknots, thick, vec, patt);
  6665.   end;
  6666.   
  6667. {-----------------------------------------------------------}
  6668. procedure TylArc (* radius : ScaledPts; centx, centy : ScaledPts;
  6669.           firstangle, secondangle : integer;
  6670.           thick : VThickness; vec : VectKind; patt : LineStyle *);
  6671.   var apts : ControlPoints; 
  6672.     numknots : integer;
  6673.     iscircle : boolean;
  6674.   begin
  6675.   iscircle := (firstangle = secondangle);
  6676.   if iscircle then
  6677.     begin
  6678.   {    maxspan := round ((360.0 / 16.0) * DEGTORAD * radius);
  6679.   {}
  6680.     defineCircleCpts (radius, centx, centy, apts, numknots);
  6681.     end
  6682.   else
  6683.     begin
  6684.   {    maxspan := round ((abs (secondangle - firstangle) / 16.0) * DEGTORAD * radius);
  6685. { }
  6686.   definearcpts (radius, centx, centy, 
  6687.           firstangle, secondangle, apts, numknots);
  6688.   end;
  6689.  
  6690.   doTylArc (iscircle, apts, numknots, thick, vec, patt); 
  6691.  
  6692.   end;
  6693.   
  6694. {-----------------------------------------------------------}
  6695. procedure TylLabel (* xpos, ypos : ScaledPts;
  6696.           fontstyle : integer;
  6697.           phrase : charstring;
  6698.           phraselen : integer *); 
  6699. var findex : integer;
  6700.   c : integer;
  6701.   spaceover : integer;
  6702.   
  6703. begin
  6704. if ((fontstyle < 1) or (fontstyle > MAXLABELFONTS)) then
  6705.   begin
  6706.   complain (ERRREALBAD);
  6707.   writeln(logfile,'Unexpected bad fontstyle in TylLabel: ',fontstyle:0,'?');
  6708.   jumpout;
  6709.   end;
  6710. findex := GetLabFont (fontstyle);
  6711. isetpos (xpos, ypos);
  6712. IPUSH;
  6713. isetfont (LFontTable[findex]^.DVIFontNum);
  6714. spaceover := LFontTable[findex]^.spacewidth;
  6715. for c := 1 to phraselen do
  6716.   begin
  6717.   if (phrase[c] <> xchr[32]) then
  6718.     begin
  6719.     cmd1byte (SET1);
  6720.     cmd1byte (xord[ phrase[ c ]]);
  6721.     end
  6722.   else
  6723.     begin (* move over *)
  6724.     cmd1byte (RIGHTLEFT + 2); (* assume distance is less than 3 bytes *)
  6725.     cmdSigned (spaceover, 3);
  6726.     end;
  6727.   end;
  6728. IPOP;
  6729. end;
  6730.  
  6731.   
  6732. (*  && start dvidvi section *)
  6733. {-----------------------------------------------------}
  6734. procedure initialize;
  6735.   var
  6736.       i: integer;
  6737.   begin
  6738.       for i := 0 to 31 do 
  6739.       xchr[i] := '?';
  6740.       xchr[32] := ' ';
  6741.       xchr[33] := '!';
  6742.       xchr[34] := '"';
  6743.       xchr[35] := '#';
  6744.       xchr[36] := '$';
  6745.       xchr[37] := '%';
  6746.       xchr[38] := '&';
  6747.       xchr[39] := '''';
  6748.       xchr[40] := '(';
  6749.       xchr[41] := ')';
  6750.       xchr[42] := '*';
  6751.       xchr[43] := '+';
  6752.       xchr[44] := ',';
  6753.       xchr[45] := '-';
  6754.       xchr[46] := '.';
  6755.       xchr[47] := '/';
  6756.       xchr[48] := '0';
  6757.       xchr[49] := '1';
  6758.       xchr[50] := '2';
  6759.       xchr[51] := '3';
  6760.       xchr[52] := '4';
  6761.       xchr[53] := '5';
  6762.       xchr[54] := '6';
  6763.       xchr[55] := '7';
  6764.       xchr[56] := '8';
  6765.       xchr[57] := '9';
  6766.       xchr[58] := ':';
  6767.       xchr[59] := ';';
  6768.       xchr[60] := '<';
  6769.       xchr[61] := '=';
  6770.       xchr[62] := '>';
  6771.       xchr[63] := '?';
  6772.       xchr[64] := '@';
  6773.       xchr[65] := 'A';
  6774.       xchr[66] := 'B';
  6775.       xchr[67] := 'C';
  6776.       xchr[68] := 'D';
  6777.       xchr[69] := 'E';
  6778.       xchr[70] := 'F';
  6779.       xchr[71] := 'G';
  6780.       xchr[72] := 'H';
  6781.       xchr[73] := 'I';
  6782.       xchr[74] := 'J';
  6783.       xchr[75] := 'K';
  6784.       xchr[76] := 'L';
  6785.       xchr[77] := 'M';
  6786.       xchr[78] := 'N';
  6787.       xchr[79] := 'O';
  6788.       xchr[80] := 'P';
  6789.       xchr[81] := 'Q';
  6790.       xchr[82] := 'R';
  6791.       xchr[83] := 'S';
  6792.       xchr[84] := 'T';
  6793.       xchr[85] := 'U';
  6794.       xchr[86] := 'V';
  6795.       xchr[87] := 'W';
  6796.       xchr[88] := 'X';
  6797.       xchr[89] := 'Y';
  6798.       xchr[90] := 'Z';
  6799.       xchr[91] := '[';
  6800.       xchr[92] := '\';
  6801.       xchr[93] := ']';
  6802.       xchr[94] := '^';
  6803.       xchr[95] := '_';
  6804.       xchr[96] := '`';
  6805.       xchr[97] := 'a';
  6806.       xchr[98] := 'b';
  6807.       xchr[99] := 'c';
  6808.       xchr[100] := 'd';
  6809.       xchr[101] := 'e';
  6810.       xchr[102] := 'f';
  6811.       xchr[103] := 'g';
  6812.       xchr[104] := 'h';
  6813.       xchr[105] := 'i';
  6814.       xchr[106] := 'j';
  6815.       xchr[107] := 'k';
  6816.       xchr[108] := 'l';
  6817.       xchr[109] := 'm';
  6818.       xchr[110] := 'n';
  6819.       xchr[111] := 'o';
  6820.       xchr[112] := 'p';
  6821.       xchr[113] := 'q';
  6822.       xchr[114] := 'r';
  6823.       xchr[115] := 's';
  6824.       xchr[116] := 't';
  6825.       xchr[117] := 'u';
  6826.       xchr[118] := 'v';
  6827.       xchr[119] := 'w';
  6828.       xchr[120] := 'x';
  6829.       xchr[121] := 'y';
  6830.       xchr[122] := 'z';
  6831.       xchr[123] := '{';
  6832.       xchr[124] := '|';
  6833.       xchr[125] := '}';
  6834.       xchr[126] := '~';
  6835.       for i := 127 to 255 do 
  6836.       xchr[i] := '?'; 
  6837.       for i := 0 to 127 do 
  6838.       xord[chr(i)] := 32;
  6839.       for i := 32 to 126 do 
  6840.       xord[xchr[i]] := i; 
  6841.       initallspline;
  6842.       initVnMnLtables;
  6843.       multifigure := 0;
  6844.       pgfigurenum := 0;
  6845.       TotBytesWritten := 0;
  6846.       ourq := 0;
  6847.       specstart := 0; 
  6848.       currpagenum := 0;
  6849.       newbackptr := (-1);
  6850.       oldbackptr := (-1);
  6851.       ourfontnum := (-1);  (* undefined *)
  6852.       origTexfont := (-1);
  6853.       ourpushdepth := 0;
  6854.       FTBDs := 0;
  6855.       InitDVIBuf;
  6856.       nf := 0;
  6857.       inpostamble := false; 
  6858.       didnewfonts := false;
  6859.       maxpages := 10000;
  6860.       sysdependent;
  6861.       s := 0;         
  6862.       skiptsclamp := false;
  6863.       ErrorOccurred := false;
  6864.     end; 
  6865.  
  6866.  
  6867.  
  6868. procedure inputln (var buffer : strng);
  6869. var
  6870.     k: 0..ARRLIMIT;
  6871. begin
  6872.  
  6873.     flush(output);
  6874.  
  6875.     if eoln(input) then
  6876.     readln(input);
  6877.     k := 1;
  6878.     while (k < ARRLIMIT) and (not eoln(input)) do 
  6879.       begin
  6880.     buffer.str[k] := input^;
  6881.     k := k + 1;
  6882.     get(input)
  6883.       end;
  6884.     buffer.str[k] := ' ';
  6885.     buffer.len := k - 1;
  6886. end;
  6887.  
  6888. function revindex (st : strng; let : char) : integer;
  6889. label 2;
  6890. var posit,i : integer;
  6891. begin
  6892.   posit := 0;
  6893.   for i := st.len downto 1 do
  6894.     begin
  6895.     if (st.str[i] = let) then
  6896.       begin
  6897.       posit := i;
  6898.       goto 2;
  6899.       end;  
  6900.     end; 
  6901. 2:
  6902.    revindex := posit;
  6903. end;
  6904.  
  6905.  
  6906. procedure stripblanks (var st : strng);
  6907. var i,j,k: integer;
  6908.   temp : charstring;
  6909.   begin
  6910.   j := 1;
  6911.   i := 1;
  6912.   while ((i <= st.len) and 
  6913.      ((st.str[i] = ' ') or (st.str[i] = xchr[HT]))) do
  6914.     begin
  6915.     j := j + 1;
  6916.     i := i + 1;
  6917.     end;
  6918.  
  6919. (* j now points to the first non-blank character in st.str *)
  6920.   i := 1;
  6921.   for k := j to st.len do
  6922.     begin
  6923.     if ((st.str[k] <> ' ') and (st.str[k] <> xchr[HT])) then
  6924.       begin
  6925.       temp[i] := st.str[k];
  6926.       i := i + 1;
  6927.       end;
  6928.     end;
  6929.    (* now copy it back *)
  6930.    if (i <> 1) then
  6931.      begin (* there was blankspace *)
  6932.      for k := 1 to (i- 1) do
  6933.        st.str[k] := temp[k];
  6934.      st.len := i - 1;
  6935.  
  6936.      st.str[i] := chr(32); (* end of string *)
  6937.  
  6938.      end;
  6939.   end;  
  6940.  
  6941.  
  6942. {-----------------------------------------------------}
  6943. procedure AskandOpenFiles;
  6944. var isok : boolean;
  6945.     i : integer;  
  6946.     rp : integer;
  6947.     tempname : strng;
  6948. begin
  6949.    isok := false;
  6950.    while (not isok) do
  6951.      begin
  6952.      write (' DVI-input File Name: ');
  6953.      inputln (dvifname);
  6954.      stripblanks (dvifname);
  6955.  
  6956.      rp := revindex (dvifname, '.');
  6957.      if (rp = 0) then
  6958.        begin 
  6959.        (* add a ".dvi" extension *)
  6960.        i := dvifname.len;
  6961.        dvifname.str[i + 1] := '.';
  6962.        dvifname.str[i + 2] := 'd';
  6963.        dvifname.str[i + 3] := 'v';
  6964.        dvifname.str[i + 4] := 'i';
  6965.        dvifname.len := i + 4;
  6966.        end;
  6967.      if (not opendvifile) then
  6968.        begin
  6969.        isok := false;  (* it is empty *)
  6970.        writestrng(dvifname,false);
  6971.        writeln(': Empty File??  Try another name.');
  6972.        end
  6973.      else
  6974.        isok := true;
  6975.      end;  (* while *)
  6976.  
  6977.         (* and ask for the name of the output file               *)
  6978.     (* default it to be the same prefix, but with a ".tyl" suffix *)
  6979.      strcopy (dvifname.str, outname.str, dvifname.len);
  6980.      outname.len := dvifname.len;
  6981.      rp := revindex (outname, '.');
  6982.      i := rp - 1;
  6983.      outname.str[i + 1] := '.';
  6984.      outname.str[i + 2] := 't';
  6985.      outname.str[i + 3] := 'y';
  6986.      outname.str[i + 4] := 'l';
  6987.      outname.len := i + 4;
  6988.      
  6989.      writeln (' DVI-output File Name :');
  6990.      write('(different than input name)[default of ');
  6991.      writestrng (outname,false);
  6992.      write(']');
  6993.      inputln (tempname);
  6994.      if (tempname.len > 1) then
  6995.        begin    (* a filename was typed in *)
  6996.        
  6997.        strcopy (tempname.str, outname.str, tempname.len);
  6998.        end;
  6999.  
  7000.      openoutputfile;
  7001.  
  7002.      strcopy (dvifname.str, logfilnam.str, dvifname.len);
  7003.      logfilnam.len := dvifname.len;
  7004.      rp := revindex (logfilnam, '.');
  7005.      (* add a ".tlog" extension *)
  7006.      i := rp - 1;
  7007.      logfilnam.str[i + 1] := '.';
  7008.      logfilnam.str[i + 2] := 't';
  7009.      logfilnam.str[i + 3] := 'l';
  7010.      logfilnam.str[i + 4] := 'o';
  7011.      logfilnam.str[i + 5] := 'g';
  7012.      logfilnam.len := i + 5;
  7013.  
  7014.      openlogfile;
  7015. end; 
  7016.  
  7017.  
  7018. {-----------------------------------------------------}
  7019.     function inTFM (z: integer): boolean;
  7020.     label
  7021.         9997, 9998, 9999;
  7022.     var
  7023.         k: integer;
  7024.         lh: integer;
  7025.         nw: integer;
  7026.         alpha, beta: integer; 
  7027.     begin
  7028.         readtfmword;
  7029.         lh := b2 * 256 + b3;
  7030.         readtfmword;
  7031.         font[nf].bc := b0 * 256 + b1;
  7032.         font[nf].ec := b2 * 256 + b3;
  7033.         if (font[nf].ec < font[nf].bc) then 
  7034.             font[nf].bc := font[nf].ec + 1;
  7035.         readtfmword;
  7036.         nw := b0 * 256 + b1;
  7037.         if ((nw = 0) or (nw > 256)) then 
  7038.             goto 9997;
  7039.         for k := 1 to 3 + lh do 
  7040.           begin
  7041.             if eof(tfmfile) then 
  7042.                 goto 9997;
  7043.             readtfmword;
  7044.             if (k = 4) then 
  7045.               if (b0 < 128) then 
  7046.                 tfmchecksum := ((b0 * 256 + b1) * 256 + b2) * 256 + b3
  7047.               else 
  7048.                 tfmchecksum := (((b0 - 256) * 256 + b1) * 256 + b2) * 256 + b3
  7049.           end; 
  7050.           
  7051.             for k := 0 to (font[nf].ec - font[nf].bc) do
  7052.               begin
  7053.                 readtfmword;
  7054.                 if (b0 > nw) then 
  7055.                     goto 9997;
  7056.                 font[nf].widths[k] := b0
  7057.               end; 
  7058.           alpha := 16 * z;
  7059.           beta := 16;
  7060.           while z >= TWO23 do
  7061.             begin
  7062.               z := z div 2;
  7063.               beta := beta div 2
  7064.             end;
  7065.         for k := 0 to nw - 1 do
  7066.           begin
  7067.             readtfmword;
  7068.             inwidth[k] := (((b3 * z) div 256 + b2 * z) div 256 + b1 * z) div beta;
  7069.             if b0 > 0 then 
  7070.                 if b0 < 255 then 
  7071.                     goto 9997
  7072.                 else 
  7073.                     inwidth[k] := inwidth[k] - alpha;
  7074.           end;
  7075.         if inwidth[0] <> 0 then 
  7076.             goto 9997;
  7077.         with font[nf] do
  7078.           begin
  7079.           for k := 0 to (ec - bc) do 
  7080.             if widths[k] = 0 then
  7081.               begin
  7082.               widths[k + bc] := TWO31;
  7083. {              pixelwidths[k + bc] := 0;}
  7084.               end
  7085.             else
  7086.               begin
  7087.               widths[k + bc] := inwidth[widths[k]];
  7088. {              pixelwidths[k + bc] := round(conv * widths[k]);}
  7089.               end;
  7090.            end; (* with *)
  7091.         inTFM := true;
  7092.         goto 9999;
  7093. 9997:
  7094.     complain (ERRREALBAD);
  7095.         writestrng(tfmname,true);
  7096.     writeln(logfile,'---not loaded, TFM file is bad');
  7097.           
  7098. 9998:
  7099.         inTFM := false;
  7100. 9999:
  7101.         
  7102.     end; 
  7103.  
  7104.  
  7105.  
  7106. {-----------------------------------------------------}
  7107. procedure Fastdefinefont (fn: integer);
  7108. var     p, k: integer;
  7109.         n, waste: integer;
  7110.         c, q, d: integer;
  7111.  
  7112. begin  { Fastdefinefont }
  7113.   c := Dsign4byte;
  7114.   q := Dsign4byte;
  7115.   d := Dsign4byte;
  7116.   p := Dget1byte;
  7117.   n := Dget1byte;
  7118.   for k := 1 to (p + n) do
  7119.     waste := Dget1byte;                         
  7120. end;  { Fastdefinefont }
  7121.  
  7122.  
  7123. {-----------------------------------------------------}
  7124.     procedure definefont (e: integer);
  7125.     var
  7126.         f: 0..MAXFONTS;
  7127.         p, k: integer;
  7128.         n: integer;
  7129.         c, q, d: integer;
  7130.         r: integer;
  7131.     begin
  7132.         if (nf = MAXFONTS) then 
  7133.         begin
  7134.       complain (ERRREALBAD);
  7135.           writeln(logfile,'TeXtyl capacity exceeded (max fonts=', MAXFONTS: 1, ')!');
  7136.           writeln('TeXtyl capacity exceeded (max fonts=', MAXFONTS: 1, ')!');
  7137.           jumpout
  7138.         end;
  7139.         font[nf].num := e;
  7140.         f := 0;
  7141.         while font[f].num <> e do  (* find first occurrence *)
  7142.             f := f + 1; 
  7143.         c := Dsign4byte;
  7144.         font[nf].checksum := c;
  7145.         q := Dsign4byte;
  7146.         font[nf].scaledsize := q;
  7147.         d := Dsign4byte;
  7148.         font[nf].designsize := d;
  7149.         p := Dget1byte;
  7150.         n := Dget1byte;
  7151.         font[nf].name.len := p + n;
  7152.         for k := 1 to (p + n) do
  7153.            font[nf].name.str[k] := Dget1byte;
  7154.  
  7155.         if (f = nf) then 
  7156.         begin (* f = nf *)
  7157.             for k := 1 to AREALENGTH do 
  7158.                 tfmname.str[k] := ' ';
  7159.  
  7160.               r := 0;
  7161.             
  7162.             for k := 1 to font[nf].name.len do 
  7163.               begin
  7164.                 r := r + 1;
  7165.                 tfmname.str[r] := xchr[font[nf].name.str[k]]
  7166.               end;
  7167.             tfmname.str[r + 1] := '.';
  7168.             tfmname.str[r + 2] := 't';
  7169.             tfmname.str[r + 3] := 'f';
  7170.             tfmname.str[r + 4] := 'm';
  7171.  
  7172.         tfmname.str[r + 5] := chr(32);
  7173.  
  7174.         tfmname.len := r + 4;
  7175.  
  7176.             if (not opentfmfile) then
  7177.           begin
  7178.             complain (ERRREALBAD);
  7179.                 writestrng(tfmname,true);
  7180.         writeln(logfile,'---not loaded, TFM file can''t be opened!');
  7181.         writestrng(tfmname, false);
  7182.         writeln(' cannot be opened. Aborting.');
  7183.         jumpout;
  7184.              end
  7185.             else 
  7186.               begin
  7187.                 if (q <= 0) or (q >= TWO27) then 
  7188.           begin
  7189.             complain (ERRREALBAD);
  7190.                     writestrng(tfmname,true);
  7191.                     writeln(logfile,'---not loaded, bad scale (', q: 1, ')!');
  7192.           end
  7193.                 else if (d <= 0) or (d >= TWO27) then 
  7194.           begin
  7195.             complain (ERRREALBAD);
  7196.                     writestrng(tfmname,true);
  7197.                     writeln(logfile,'---not loaded, bad design size (', d: 1, ')!');
  7198.           end
  7199.                 else
  7200.                   if inTFM(q) then
  7201.                     begin (* intfm *)
  7202.                     font[nf].space := q div 6;
  7203.                     if (c <> 0) and (tfmchecksum <> 0) and (c <> tfmchecksum) then 
  7204.                       begin
  7205.                       writeln(logfile,'Problem in fig#',pgfigurenum:0,' on page ',currpagenum:0);
  7206.                   writestrng(tfmname,true);
  7207.                       writeln(logfile,'---beware: check sums do not agree!');
  7208.                       writeln(logfile,'   (', c: 1, ' vs. ', tfmchecksum: 1, ')');
  7209.                       end;
  7210.                     d := round(100.0 * conv * q / (trueconv * d));
  7211.                     nf := nf + 1;
  7212.                     font[nf].space := 0;
  7213.                     end (* intfm *)
  7214.                  end;
  7215.             end;
  7216.     end;
  7217.  
  7218. {-----------------------------------------------------}
  7219.     function firstpar (o: OctByt): integer;
  7220.     var fpar : integer;
  7221.     begin
  7222.        case (o) of
  7223.             0, 1, 2, 3, 4, 5, 6,
  7224.             7, 8, 9, 10, 11, 12, 13,
  7225.             14, 15, 16, 17, 18, 19, 20,
  7226.             21, 22, 23, 24, 25, 26, 27,
  7227.             28, 29, 30, 31, 32, 33, 34,
  7228.             35, 36, 37, 38, 39, 40, 41,
  7229.             42, 43, 44, 45, 46, 47, 48,
  7230.             49, 50, 51, 52, 53, 54, 55,
  7231.             56, 57, 58, 59, 60, 61, 62,
  7232.             63, 64, 65, 66, 67, 68, 69,
  7233.             70, 71, 72, 73, 74, 75, 76,
  7234.             77, 78, 79, 80, 81, 82, 83,
  7235.             84, 85, 86, 87, 88, 89, 90,
  7236.             91, 92, 93, 94, 95, 96, 97,
  7237.             98, 99, 100, 101, 102, 103, 104,
  7238.             105, 106, 107, 108, 109, 110, 111,
  7239.             112, 113, 114, 115, 116, 117, 118,
  7240.             119, 120, 121, 122, 123, 124, 125,
  7241.             126, 127:
  7242.                 fpar := o - 0;
  7243.             128, 133, 235, 239, 243:
  7244.                 fpar := Dget1byte;
  7245.             129, 134, 236, 240, 244:
  7246.                 fpar := Dget2byte;
  7247.             130, 135, 237, 241, 245:
  7248.                 fpar := Dget3byte;
  7249.             143, 148, 153, 157, 162, 167:
  7250.                 fpar := Dsign1byte;
  7251.             144, 149, 154, 158, 163, 168:
  7252.                 fpar := Dsign2byte;
  7253.             145, 150, 155, 159, 164, 169:
  7254.                 fpar := Dsign3byte;
  7255.             131, 132, 136, 137, 146, 151, 156,
  7256.             160, 165, 170, 238, 242, 246:
  7257.                 fpar := Dsign4byte;
  7258.             138, 139, 140, 141, 142, 247, 248,
  7259.             249, 250, 251, 252, 253, 254, 255:
  7260.                 fpar := 0;
  7261.             147:
  7262.                 fpar := w;
  7263.             152:
  7264.                 fpar := x;
  7265.             161:
  7266.                 fpar := y;
  7267.             166:
  7268.                 fpar := z;
  7269.             171, 172, 173, 174, 175, 176, 177,
  7270.             178, 179, 180, 181, 182, 183, 184,
  7271.             185, 186, 187, 188, 189, 190, 191,
  7272.             192, 193, 194, 195, 196, 197, 198,
  7273.             199, 200, 201, 202, 203, 204, 205,
  7274.             206, 207, 208, 209, 210, 211, 212,
  7275.             213, 214, 215, 216, 217, 218, 219,
  7276.             220, 221, 222, 223, 224, 225, 226,
  7277.             227, 228, 229, 230, 231, 232, 233,
  7278.             234:
  7279.                 fpar := o - 171
  7280.         end;
  7281.         firstpar := fpar;
  7282.     end;
  7283.  
  7284. {-----------------------------------------------------}
  7285.     function specialcases (o: OctByt; p: integer): boolean;
  7286.     label
  7287.         46, 44, 30, 9998;
  7288.     var
  7289.         pure: boolean;
  7290.  
  7291.     begin
  7292.         pure := true;
  7293.         if ((o < 157) or (o > 249)) then
  7294.           begin
  7295.         complain (ERRREALBAD);
  7296.             writeln(logfile, 'undefined command ', o: 1, '!');
  7297.             goto 30;
  7298.           end;
  7299.         case (o) of 
  7300.             157, 158, 159, 160:
  7301.                 begin
  7302.                     goto 44;
  7303.                 end;
  7304.             161, 162, 163, 164, 165:
  7305.                 begin
  7306.                     y := p;
  7307.                     goto 44;
  7308.                 end;
  7309.             166, 167, 168, 169, 170:
  7310.                 begin
  7311.                     z := p;
  7312.                     goto 44;
  7313.                 end; 
  7314.             171, 172, 173, 174, 175, 176, 177,
  7315.             178, 179, 180, 181, 182, 183, 184,
  7316.             185, 186, 187, 188, 189, 190, 191,
  7317.             192, 193, 194, 195, 196, 197, 198,
  7318.             199, 200, 201, 202, 203, 204, 205,
  7319.             206, 207, 208, 209, 210, 211, 212,
  7320.             213, 214, 215, 216, 217, 218, 219,
  7321.             220, 221, 222, 223, 224, 225, 226,
  7322.             227, 228, 229, 230, 231, 232, 233,
  7323.             234:
  7324.                 begin
  7325.                     goto 46;
  7326.                 end;
  7327.             235, 236, 237, 238:
  7328.                 begin
  7329.                     goto 46;
  7330.                 end;
  7331.             243, 244, 245, 246:
  7332.                 begin
  7333.                     definefont(p);
  7334.                     goto 30;
  7335.                 end;
  7336.  
  7337.             239, 240, 241, 242:
  7338.                 begin   (* =========specials============= *)
  7339.                   mainhandlespecials (o, p);
  7340.                   goto 30;
  7341.                 end; 
  7342.             247:
  7343.                 begin
  7344.           complain (ERRREALBAD);
  7345.                   writeln(logfile,'preamble command within a page!');
  7346.                   goto 9998;
  7347.                 end;
  7348.             248, 249:
  7349.                 begin
  7350.           complain (ERRREALBAD);
  7351.                   writeln(logfile,'postamble command within a page!');
  7352.                   goto 9998;
  7353.                 end;
  7354.        (*     others:
  7355.                 begin
  7356.                   write(' ', 'undefined command ', o: 1, '!');
  7357.                   goto 30;
  7358.                 end   
  7359.     *)
  7360.         end;
  7361. 44:  (* label *)
  7362.         if (v > 0) and (p > 0) then 
  7363.             if (v > TWO31 - p) then 
  7364.             begin
  7365.                 p := TWO31 - v
  7366.             end;
  7367.         if (v < 0) and (p < 0) then 
  7368.             if ((-v) > (p + TWO31)) then 
  7369.             begin
  7370.                 p := -v - TWO31
  7371.             end;
  7372.  
  7373.         v := v + p;
  7374.  
  7375.         goto 30;
  7376. 46:  (* label *)
  7377.         font[nf].num := p;
  7378.         curfont := 0;
  7379.         while font[curfont].num <> p do 
  7380.             curfont := curfont + 1;
  7381.         goto 30 ;
  7382. 9998:
  7383.         pure := false;
  7384. 30:
  7385.         specialcases := pure;
  7386.     end; 
  7387.  
  7388.  
  7389. {-----------------------------------------------------}
  7390.     function dopage : boolean;
  7391.     label
  7392.         41, 42, 43, 30, 9998, 9999;
  7393.     var
  7394.         o: OctByt;
  7395.         p, q: integer;
  7396.  
  7397.     begin
  7398.         curfont := nf;
  7399.      s := 0;
  7400.         h := 0;
  7401.         v := 0;
  7402.         w := 0;
  7403.         x := 0;
  7404.         y := 0;
  7405.         z := 0;
  7406.       
  7407.         ourxpos := 0;
  7408.     ourypos := 0;
  7409.     ourfontnum := (-1);
  7410.         while true do 
  7411.           begin 
  7412.             o := Dget1byte;
  7413.             p := firstpar(o);
  7414.             if eof(dvifile) then begin
  7415.                 writeln(logfile, 'Bad DVI file: ', 'the file ended prematurely', '!');
  7416.                 writeln('Bad DVI file: ', 'the file ended prematurely', '!');
  7417.                 jumpout
  7418.             end; 
  7419.             if o <= 131 then 
  7420.               begin 
  7421.                 goto 41;
  7422.               end
  7423.             else
  7424.               begin
  7425.                if (o > 156) then
  7426.                  begin
  7427.                    if specialcases(o, p) then 
  7428.                       goto 30
  7429.                    else 
  7430.                       goto 9998;
  7431.                  end;
  7432.                                          
  7433.                 case (o) of
  7434.                     133, 134, 135, 136:
  7435.                         begin
  7436.                           goto 41;
  7437.                         end;
  7438.                     132, 137:
  7439.                         begin
  7440.                             goto 42
  7441.                         end;
  7442.                     138:
  7443.                         begin
  7444.                             goto 30;
  7445.                         end;
  7446.                     139:
  7447.                         begin (* BOP *)
  7448.               complain (ERRREALBAD);
  7449.                           writeln(logfile, 'bop occurred before eop');
  7450.                           goto 9998; (* Fail *)
  7451.                         end;
  7452.                     140:
  7453.                         begin (* EOP *)
  7454.                             if (s <> 0) then 
  7455.                   begin
  7456.                   complain (ERRREALBAD);
  7457.                               writeln(logfile, 'stack not empty at end of page (level ', s: 1, ')!');
  7458.                   end;
  7459.                 if (multifigure <> 0) then
  7460.                   begin
  7461.                     complain (ERRBAD);
  7462.                     writeln(logfile,'Some figure definition not closed at end of page ', currpagenum:0,'!');
  7463.                   end;
  7464.                                    
  7465.                             write (currpagenum:0,']'); 
  7466.                             write (logfile,currpagenum:0,']'); 
  7467.                 if ((currpagenum mod 10) = 0) then
  7468.                   writeln;
  7469.                             dopage := true;
  7470.                             goto 9999;
  7471.                         end;
  7472.                     141:
  7473.                         begin (* PUSH *)
  7474.                           with stack[s] do 
  7475.                             begin
  7476.                             sh := h;
  7477.                             sv := v;
  7478.                             sw := w;
  7479.                             sx := x;
  7480.                             sy := y;
  7481.                             sz := z;
  7482.                             end; (* with *)
  7483.                           s := s + 1;
  7484.                           goto 30;
  7485.                         end;
  7486.                     142:
  7487.                         begin (* POP *)
  7488.                             if s = 0 then 
  7489.                   begin
  7490.                   complain (ERRREALBAD);
  7491.                               writeln(logfile,'illegal pop at level zero!');
  7492.                   end
  7493.                             else 
  7494.                   begin
  7495.                                 s := s - 1;
  7496.                                 with stack[s] do
  7497.                                   begin
  7498.                                   h := sh;
  7499.                                   v := sv;
  7500.                                   w := sw;
  7501.                                   x := sx;
  7502.                                   y := sy;
  7503.                                   z := sz;
  7504.                                   end;
  7505.                                end;
  7506.                             goto 30;
  7507.                         end; 
  7508.                     143, 144, 145, 146:
  7509.                         begin
  7510.                             q := p;
  7511.                             goto 43
  7512.                         end;
  7513.                     147, 148, 149, 150, 151:
  7514.                         begin
  7515.                             w := p;
  7516.                             q := p;
  7517.                             goto 43
  7518.                         end;
  7519.                     152, 153, 154, 155, 156:
  7520.                         begin
  7521.                             x := p;
  7522.                             q := p;
  7523.                             goto 43
  7524.                         end; 
  7525.                 (*    others:
  7526.                         if specialcases(o, p) then 
  7527.                             goto 30
  7528.                         else 
  7529.                             goto 9998;
  7530.                                 *)                          
  7531.                 end; (* case *)
  7532.             end; (* else *)
  7533. 41:   (* finish cmd to set/put a char *)
  7534.             if p < 0 then 
  7535.                 p := 255 - (-1 - p) mod 256
  7536.             else if p >= 256 then 
  7537.                 p := p mod 256;
  7538.             if (p < font[curfont].bc) or (p > font[curfont].ec) then 
  7539.                 q := TWO31
  7540.             else 
  7541.                 q := font[curfont].widths[p];
  7542.             if (q = TWO31) then 
  7543.               begin
  7544.             complain (ERRREALBAD);
  7545.                 writeln(logfile,'Character ', p:1,' invalid in font #',curfont:0);
  7546.               end;
  7547.             if o >= 133 then 
  7548.                 goto 30;
  7549.             if q = TWO31 then 
  7550.                 q := 0;
  7551.             goto 43;
  7552.  
  7553. 42:  (* finish cmd to set/put rule *)
  7554.             q := Dsign4byte;
  7555.             if o = 137 then 
  7556.                 goto 30;
  7557.             goto 43 ;
  7558.  
  7559. 43:  (*finish cmd that sets h += q *)
  7560.             if (h > 0) and (q > 0) then 
  7561.                 if (h > (TWO31 - q)) then 
  7562.                   begin
  7563.                     q := TWO31 - h
  7564.                   end;
  7565.             if (h < 0) and (q < 0) then 
  7566.                 if ((-h) > (q + TWO31)) then 
  7567.                   begin
  7568.                     q := (-h) - TWO31
  7569.                   end;
  7570.  
  7571.             h := h + q;
  7572. 30:
  7573.         end;
  7574. 9998:
  7575.         dopage := false;
  7576. 9999:
  7577.  
  7578.     end; 
  7579.  
  7580. {-----------------------------------------------------}
  7581.     procedure skippages;
  7582.     label
  7583.         9999;
  7584.     var
  7585.         p: integer;
  7586.         k: 0..255;
  7587.         downthedrain: integer;
  7588.     begin
  7589.         while true do 
  7590.           begin
  7591.             if eof(dvifile) then 
  7592.               begin
  7593.                 writeln(logfile, 'Bad DVI file: ', 'the file ended prematurely', '!');
  7594.                 write(' ', 'Bad DVI file: ', 'the file ended prematurely', '!');
  7595.                 jumpout
  7596.               end;
  7597.             k := Dget1byte;
  7598.             p := firstpar(k);
  7599.             case (k) of
  7600.                 139:
  7601.                     begin (* BOP *)
  7602.                         newbackptr := DVIMark + TotBytesWritten - 1;
  7603.             currpagenum := Dsign4byte; (* count[0] *)
  7604.                         for k := 1 to 9 do 
  7605.                             waste := Dsign4byte; (* WAS count[k] := *)
  7606.                         downthedrain := Dsign4byte;
  7607.                         BackupInBuf (4);
  7608.                         cmdSigned (oldbackptr, 4);
  7609.                         oldbackptr := newbackptr;
  7610.                         write(' ['); 
  7611.                         write(logfile,' ['); 
  7612.                         goto 9999;
  7613.                     end;
  7614.                 132, 137: (* RULE *)
  7615.                     downthedrain := Dsign4byte;
  7616.                 243, 244, 245, 246:
  7617.                     begin
  7618.                         definefont(p);
  7619.                     end;
  7620.                 239, 240, 241, 242: (* specials *)
  7621.                     begin
  7622.                         mainhandlespecials (k, p);
  7623.                     end;
  7624.                 248:
  7625.                     begin (* POST *)
  7626.                         ourq := DVIMark + TotBytesWritten - 1;
  7627.                         inpostamble := true;
  7628.                         goto 9999
  7629.                     end;
  7630.               (*  others:
  7631.                     null
  7632.         *)
  7633.             end
  7634.         end;
  7635.     9999:
  7636.  
  7637.     end; 
  7638.  
  7639. {-----------------------------------------------------}
  7640.     procedure readpostamble;
  7641.     var
  7642.         k: integer;
  7643.         p, q, m: integer;
  7644.         indx : integer;
  7645.     begin
  7646.         if (Dsign4byte <> numerator) then 
  7647.             writeln(logfile,'Postamble',' numerator',' doesn''t match the preamble!');
  7648.         if (Dsign4byte <> denominator) then 
  7649.             writeln(logfile,'Postamble',' denominator',' doesn''t match the preamble!');
  7650.         if (Dsign4byte <> mag) then 
  7651.            begin
  7652.            writeln(logfile,'Postamble',' magnification',' doesn''t match the preamble!');
  7653.            end;
  7654.         maxv := Dsign4byte;
  7655.         maxh := Dsign4byte;
  7656.         maxs := Dget2byte;
  7657.         BackupInBuf (2);
  7658.         cmd2byte (maxs + 2); (* pretend the stack depth 
  7659.                   * does not increase by
  7660.                   * more than two
  7661.                   *)
  7662.         
  7663.         totalpages := Dget2byte;
  7664.         repeat
  7665.             k := Dget1byte;
  7666.             if (k >= 243) and (k < 247) then 
  7667.               begin
  7668.                 p := firstpar(k);
  7669.                 Fastdefinefont(p);
  7670.                 k := 138;
  7671.               end
  7672.         until k <> 138; (* NOP *)
  7673.  
  7674.        (* here, backup 1, enter all our fonts and 
  7675.         then output the 249 that we backed over *)
  7676.         BackupInBuf (1);
  7677.         for indx := 1 to MFontsDefd do
  7678.           begin
  7679.           with MFontTable[indx]^ do 
  7680.             enterfont (DVIFontNum, Cksum, DesSize,
  7681.                        DesSize, FontName );
  7682.           end; (* for *)
  7683.         for indx := 1 to VFontsDefd do
  7684.           begin
  7685.           with VFontTable[indx]^ do
  7686.             enterfont (DVIFontNum, Cksum, DesSize,
  7687.                         DesSize, FontName);
  7688.           end;  (* for *)
  7689.     for indx := 1 to LFontsDefd do
  7690.       begin
  7691.       with LFontTable[indx]^ do
  7692.         enterfont (DVIFontNum, Cksum, DesSize,
  7693.                 DesSize, FontName);    
  7694.       end;
  7695.         cmd1byte(249);  (* post post *)
  7696.  
  7697.         if (k <> 249) then 
  7698.             writeln(logfile,'byte ',k:0,' is not postpost!');
  7699.         q := Dsign4byte;
  7700.         BackupInBuf (4);
  7701.         cmd4byte (ourq);
  7702.         m := Dget1byte;
  7703.         if (m <> 2) then 
  7704.             writeln(logfile,'identification should be ', 2: 1, '!');
  7705.         m := 223;
  7706.         while (m = 223) and not eof(dvifile) do 
  7707.             m := Dget1byte;
  7708.         if not eof(dvifile) then 
  7709.     begin
  7710.             writeln(' ', 'Bad DVI file: ', 'signature in should be 223', '!');
  7711.             writeln(logfile, 'Bad DVI file: ', 'signature in should be 223', '!');
  7712.             jumpout
  7713.         end;
  7714.     end;
  7715.  
  7716.  
  7717. (* MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN *)
  7718. begin (* main *)
  7719.     initialize;
  7720.     AskandOpenFiles;  (* ask for filenames of inputdvi and outputfil *)
  7721.  
  7722.     writeln(logfile, TylVersion,' for Berkeley Unix');    
  7723.  
  7724.     write(logfile,'Reading File: ');
  7725.     writestrng(dvifname,true);     
  7726.     writeln(logfile);
  7727.  
  7728.  
  7729.     p := Dget1byte;
  7730.     if (p <> 247) then 
  7731.     begin
  7732.         write(' ', 'Bad DVI file: ', 'First byte isn''t start of preamble!', '!');
  7733.         writeln(logfile,'Bad DVI file: ', 'First byte isn''t start of preamble!', '!');
  7734.         jumpout
  7735.     end;
  7736.     p := Dget1byte;
  7737.     if (p <> 2) then 
  7738.         writeln(logfile,'identification in byte 1 should be ', 2: 1, '!');
  7739.     numerator := Dsign4byte;
  7740.     denominator := Dsign4byte;
  7741.     if (numerator <= 0) then 
  7742.     begin
  7743.         write(' ', 'Bad DVI file: ', 'numerator is ', numerator: 1, '!');
  7744.         writeln(logfile, 'Bad DVI file: ', 'numerator is ', numerator: 1, '!');    
  7745.         jumpout
  7746.     end;
  7747.     if (denominator <= 0) then 
  7748.     begin
  7749.         write(' ', 'Bad DVI file: ', 'denominator is ', denominator: 1, '!');
  7750.         writeln(logfile, 'Bad DVI file: ', 'denominator is ', denominator: 1, '!');
  7751.         jumpout
  7752.     end;
  7753.     conv := numerator / 254000.0 * (resolution / denominator);
  7754.     mag := Dsign4byte;
  7755.     if (mag <= 0) then 
  7756.     begin
  7757.         write(' ', 'Bad DVI file: ', 'magnification is ', mag: 1, '!');
  7758.         writeln(logfile, 'Bad DVI file: ', 'magnification is ', mag: 1, '!');
  7759.         jumpout
  7760.     end;
  7761.     magfactor := mag / 1000.0;
  7762.     trueconv := conv;
  7763.     conv := trueconv * magfactor;
  7764.     p := Dget1byte;     (* the 'k' of the preamble *)
  7765.     while p > 0 do 
  7766.     begin
  7767.         p := p - 1;
  7768.         waste := Dget1byte;
  7769.     end;
  7770.  
  7771.     skippages;
  7772.     if not inpostamble then 
  7773.     begin 
  7774.         while (maxpages > 0) do 
  7775.           begin (* while *)
  7776.             maxpages := maxpages - 1;
  7777.             if (not dopage) then 
  7778.               begin
  7779.                 write(' ', 'Bad DVI file: ', 'page ended unexpectedly', '!');
  7780.                 writeln(logfile, 'Bad DVI file: ', 'page ended unexpectedly', '!');
  7781.                 jumpout
  7782.               end;
  7783.         (* now we are at an EOP ---end of page *)
  7784.         (*  flushout GDVIbuffer, and reset counters *)
  7785. {         writeln('EOP: bytes used= ',GDVIBuf.TotByteLen:0);  }
  7786.             WriteDVIBuf;
  7787.             ClearDVIBuf;
  7788.             multifigure := 0;
  7789.         pgfigurenum := 0;
  7790.             FTBDs := 0;
  7791.             didnewfonts := false;
  7792.             repeat
  7793.                 k := Dget1byte;
  7794.                 if (k >= 243) and (k < 247) then  
  7795.                   begin (* fontdefs *)
  7796.                     p := firstpar(k);
  7797.                     definefont(p);
  7798.                     k := 138
  7799.                   end;
  7800.             until (k <> 138); (* nop *)
  7801.  
  7802.             if (k = 248) then 
  7803.             begin
  7804.                 inpostamble := true;
  7805.                 ourq := DVIMark + TotBytesWritten - 1;
  7806.                 goto 30
  7807.             end;
  7808.  
  7809.             if (k = 139) then  (* BOP *)
  7810.             begin
  7811.         newbackptr := DVIMark + TotBytesWritten - 1;
  7812.         currpagenum := Dsign4byte; (* Count[0] *)
  7813.         for k := 1 to 9 do 
  7814.             waste := Dsign4byte; (* WAS count[k] := *)
  7815.         waste := Dsign4byte; (* backpointer *)
  7816.         BackupInBuf (4);
  7817.         cmdSigned (oldbackptr, 4);
  7818.         oldbackptr := newbackptr;
  7819.         write(' ['); 
  7820.         write(logfile,' ['); 
  7821.           end
  7822.         else
  7823.               begin (* NOT bop?? *)
  7824.         writeln('We did not find BOP when expected');
  7825.         writeln(logfile,'We did not find BOP when expected');
  7826.                 jumpout;
  7827.               end;
  7828.  
  7829.         end; (* while *)
  7830. 30: 
  7831.     end; (* if not inpostamble *)
  7832.     if (not inpostamble) then 
  7833.     skippages;
  7834.     waste := Dsign4byte; (* ptr to the last bop in file *)
  7835.     BackupInBuf (4);
  7836.     cmdSigned (oldbackptr, 4);
  7837.     readpostamble;
  7838.     WriteDVIBuf;
  7839.  
  7840.     while ((TotBytesWritten mod 4) <> 0) do
  7841.        OutputByte(223);  (* final signatures *)
  7842.  
  7843.     writeln;
  7844.     writeln(logfile);
  7845.     write ('Output written on '); 
  7846.     writestrng(outname, false); 
  7847.     write(' (',currpagenum:0,' page');
  7848.     if (currpagenum > 1) then
  7849.       write('s');
  7850.     writeln(', ',TotBytesWritten:0,' bytes).');
  7851.  
  7852.     write (logfile,'Output written on ');
  7853.     writestrng(outname, true); 
  7854.     write(logfile,' (',currpagenum:0,' page');
  7855.     if (currpagenum > 1) then
  7856.       write(logfile,'s');
  7857.     writeln(logfile,', ',TotBytesWritten:0,' bytes).');
  7858.  
  7859.     write ('Log written on ');
  7860.     writestrng(logfilnam, false); writeln;
  7861.     write (logfile,'Log written on '); 
  7862.     writestrng(logfilnam, true); writeln (logfile);
  7863.     writeln;
  7864.     writeln(logfile);
  7865. 666:
  7866.     if (ErrorOccurred) then
  7867.       begin
  7868.         writeln;
  7869.         writeln('Some error(s) occurred. Please check Logfile for details');
  7870.         writeln('Assume that the outputfile is incorrect');
  7871.       end;
  7872. end. 
  7873.  
  7874.